module drawingProgram where
open import Unit
open import Data.Bool.Base
open import Data.Char.Base renaming (primCharEquality to charEquality)
open import Data.Nat.Base hiding (_≟_;_⊓_; _+_; _*_)
open import Data.List.Base hiding (_++_)
open import Data.Integer.Base hiding (suc)
open import Data.String.Base
open import Data.Maybe.Base
open import NativeIO
open import Function
open import Size renaming (Size to AgdaSize)
open import SizedIO.Base
open import SizedIO.IOGraphicsLib hiding (GraphicsCommands; GraphicsResponses; GraphicsInterface; IOGraphics; getWindowEvent; openWindow; drawInWindow; closeWindow; translateIOGraphicsLocal; translateIOGraphics)
open import NativeInt
data GraphicsCommands : Set where
closeWindow : Window → GraphicsCommands
maybeGetWindowEvent : Window → GraphicsCommands
getWindowEvent : Window → GraphicsCommands
openWindowNotEx : String → Size → GraphicsCommands
openWindow : String → (Maybe Point) → (Maybe Size)
→ RedrawMode → (Maybe Word32) → GraphicsCommands
timeGetTime : GraphicsCommands
drawInWindow : Window → Graphic → GraphicsCommands
print : String → GraphicsCommands
GraphicsResponses : GraphicsCommands → Set
GraphicsResponses (maybeGetWindowEvent w) = Maybe Event
GraphicsResponses (getWindowEvent w) = Event
GraphicsResponses (closeWindow w) = Unit
GraphicsResponses (openWindowNotEx s s') = Window
GraphicsResponses (openWindow s p s' r w) = Window
GraphicsResponses timeGetTime = Word32
GraphicsResponses _ = Unit
GraphicsInterface : IOInterface
Command GraphicsInterface = GraphicsCommands
Response GraphicsInterface = GraphicsResponses
IOGraphics : AgdaSize → Set → Set
IOGraphics i = IO GraphicsInterface i
translateIOGraphicsLocal : (c : GraphicsCommands) → NativeIO (GraphicsResponses c)
translateIOGraphicsLocal (maybeGetWindowEvent w) = nativeMaybeGetWindowEvent w
translateIOGraphicsLocal (getWindowEvent w) = nativeGetWindowEvent w
translateIOGraphicsLocal (closeWindow w) = nativeCloseWindow w
translateIOGraphicsLocal (openWindowNotEx str size) = nativeOpenWindow str size
translateIOGraphicsLocal (openWindow str point size mode word) = nativeOpenWindowEx str point size mode word
translateIOGraphicsLocal timeGetTime = nativeTimeGetTime
translateIOGraphicsLocal (drawInWindow w g) = nativeDrawInWindow w g
translateIOGraphicsLocal (print s) = nativePutStrLn s
translateIOGraphics : {A : Set} → IOGraphics ∞ A → NativeIO A
translateIOGraphics = translateIO translateIOGraphicsLocal
integerLess : ℤ → ℤ → Bool
integerLess x y with ∣(y - (x ⊓ y))∣
... | zero = true
... | z = false
line : Point → Point → Graphic
line p newpoint = withColor red (polygon
(nativePoint x y
∷ nativePoint a b
∷ nativePoint (a + xAddition) (b + yAddition)
∷ nativePoint (x + xAddition) (y + yAddition)
∷ [] ) )
where
x = nativeProj1Point p
y = nativeProj2Point p
a = nativeProj1Point newpoint
b = nativeProj2Point newpoint
diffx = + ∣ (a - x) ∣
diffy = + ∣ (b - y) ∣
diffx*3 = diffx * (+ 3)
diffy*3 = diffy * (+ 3)
condition = (integerLess diffx diffy*3) ∧ (integerLess diffy diffx*3)
xAddition = if condition then + 2 else + 1
yAddition = if condition then + 2 else + 1
State = Maybe Point
loop : ∀{i} → Window → State → IOGraphics i Unit
force (loop w s) = do' (getWindowEvent w)
λ{ (Key c t) → if charEquality c 'x' then do (closeWindow w) return
else loop w s
; (MouseMove p₂) → case s of
λ{ nothing → loop w (just p₂) ;
(just p₁) → do (drawInWindow w (line p₁ p₂)) λ _ →
loop w (just p₂) }
; _ → loop w s }
program : ∀{i} → IOGraphics i Unit
program =
do (openWindow "Drawing Program" nothing (just (size (+ 1000) (+ 1000)))
nativeDrawGraphic nothing) λ window →
loop window nothing
main : NativeIO Unit
main = nativeRunGraphics (translateIOGraphics program)