Unknown - haskell-notes

шесть аргументов функции обозначают пары диапазонов по каждой из трёх координат. При этом вершины

передаются не списком а в специальном do-блоке. За счёт этого мы можем изменить какие-нибудь парамет-

ры OpenGLво время рисования. Обратите внимание на то, как мы изменяем цвет примитива. Перед тем как

рисовать примитив мы устанавливаем значение цвета (color).

Анимация

Оживим нашу картинку. При клике мышкой шарик игрока последует в направлении курсора. Для того

чтобы картинка задвигалась нам необходимо обновлять рисунок с определённой частотой. Мы будем регу-

лировать частоту обновления с помощью функции sleep, с её помощью мы можем задержать выполнение

программы (время измеряется в секундах):

sleep :: Double -> IO()

За перехват действий пользователя отвечает функции:

getMouseButton

:: MouseButton -> IO KeyButtonState

mousePos

:: StateVar Position

Функция getMouseButton сообщает текущее состояние кнопок мыши, мы будем перехватывать положение

мыши во время нажатия левой кнопки:

292 | Глава 20: Императивное программирование

onMouse ball = do

mb <-getMouseButton ButtonLeft

when (mb == Press) (get mousePos >>=updateVel ball)

Стандартная функция when из модуля Control.Monadвыполняет действие только в том случае, если пер-

вый аргумент равен True. Для обновления положения и направления скорости шарика нам придётся вос-

пользоваться глобальной переменной типа IORef Ball:

data Ball = Ball

{ ballPos :: Vec2d

, ballVel :: Vec2d

}

Код программы:

module Main where

import Control.Applicative

import Data.IORef

import Graphics.UI.GLFW

import Graphics.Rendering.OpenGL

import System.Exit

import Control.Monad

type Time = Double

title =”Hello OpenGL”

width, height :: GLsizei

fps :: Int

fps =60

frameTime :: Time

frameTime =1000 *((1 ::Double) /fromIntegral fps)

width

=700

height

=600

w2, h2 :: GLfloat

w2 =(fromIntegral $width) /2

h2 =(fromIntegral $height)

/2

dw2, dh2 :: GLdouble

dw2 =fromRational $toRational w2

dh2 =fromRational $toRational h2

type Vec2d =( GLfloat, GLfloat)

data Ball = Ball

{ ballPos :: Vec2d

, ballVel :: Vec2d

}

initBall = Ball(0, 0) (0, 0)

dt :: GLfloat

dt =0.3

minVel =10

main = do

initialize

openWindow ( Sizewidth height) [] Window

windowTitle $=title

Основные библиотеки | 293

clearColor $= Color41 1 1 1

ortho ( -dw2) (dw2) ( -dh2) (dh2) ( -1) 1

ball <-newIORef initBall

windowCloseCallback $=exitWith ExitSuccess

windowSizeCallback

$=(\size ->viewport $=( Position0 0, size))

loop ball

loop :: IORef Ball -> IO()

loop ball = do

display ball

onMouse ball

sleep frameTime

loop ball

display ball = do

(px, py) <-ballPos <$>get ball

(vx, vy) <-ballVel <$>get ball

ball $= Ball(px +dt *vx, py +dt *vy) (vx, vy)

clear [ ColorBuffer]

color black

line ( -ow2) ( -oh2) ( -ow2) oh2

line ( -ow2) oh2

ow2

oh2

line ow2

oh2

ow2

( -oh2)

line ow2

( -oh2)

( -ow2) ( -oh2)

color red

circle px py 10

swapBuffers

whereow2 =w2 -50

oh2 =h2 -50

onMouse ball = do

mb <-getMouseButton ButtonLeft

when (mb == Press) (get mousePos >>=updateVel ball)

updateVel ball pos = do

(p0x, p0y) <-ballPos <$>get ball

v0

<-ballVel <$>get ball

size <-get windowSize

let(p1x, p1y) =mouse2canvas size pos

v1 =scaleV (max minVel $len v0) $norm (p1x -p0x, p1y -p0y)

ball $= Ball(p0x, p0y) v1

wherenorm v @(x, y) =(x /len v, y /len v)

len

(x, y) =sqrt (x *x +y *y)

scaleV k (x, y) =(k *x, k *y)

mouse2canvas :: Size -> Position ->( GLfloat, GLfloat)

mouse2canvas ( Sizesx sy) ( Positionmx my) =(x, y)

whered a b

=fromIntegral a /fromIntegral b

x

=fromIntegral width *(d mx sx -0.5)

y

=fromIntegral height *(negate $d my sy -0.5)

vertex2f :: GLfloat -> GLfloat -> IO()

vertex2f a b =vertex ( Vertex3a b 0)

-- colors

...white, black, red

-- primitives