HaskellとOpenGLをつかって四角形を描画する

うまく動いたら雛形にでも使ってやってください。



参考サイト
　　　GLUTによる「手抜き」OpenGL入門
　　　プログラミング/Haskell/HSDL - Flightless wing


import Graphics.UI.GLUT
import Graphics.Rendering.OpenGL.GLU
import System.Exit
import Data.IORef

--タイマの間隔
timerInterval = 40

main = do 
    --回転の角度を初期化
    rot <- newIORef 0.0
    arg <- newIORef 10.4
    
    --GLUTの初期化
    initialDisplayMode $= [RGBAMode, DoubleBuffered]
    initialWindowSize $= Size 640 480
    initialize "" []

    --ウィンドウを作る
    createWindow "GLUTpractice"

    --表示に使うコールバック関数の指定
    displayCallback $= display rot arg
    
    --ウィンドウのサイズが変更された時に呼ぶコールバック関数の指定
    reshapeCallback $= Just reshape
    
    --キーボードやマウスのコールバック
    keyboardMouseCallback $= Just (keyboardProc arg)
    
    --タイマを作る
    addTimerCallback timerInterval $ timerProc (display rot arg)

    --GLUTのメインループに入る
    mainLoop

display rot arg= do
    --回転させる
    w<-readIORef arg 
    --w <- readIORef hoge
    modifyIORef rot (+w)
    r <- readIORef rot
 
    --背景を黒にする
    clearColor $= Color4 0.0 0.0 0.0 0.0
    clear [ColorBuffer]
    
    --単位行列を読み込む
    loadIdentity
    
    --表示
    currentColor $= Color4 0 0 1 0  -- 描写する直前に色を指定するようだ
    preservingMatrix $ do
        translate (Vector3 100 100 (0::Double))
        rotate r (Vector3 0.0 0.0 1.0 :: Vector3 GLdouble) -- rotate 度数法での角度
        {-- renderPrimitive Quads $ mapM_ vertex [
                    Vertex3 0.10 0.10 0.0,
                    Vertex3 (-0.10) 0.10 0.0,
            Vertex3 (-0.10) (-0.10) 0.0,
            Vertex3 0.10 (-0.10) 0.0 :: Vertex3 GLfloat] --}       
        renderPrimitive Quads $ mapM_ vertex [
                    Vertex3 50 50 0.0,
                    Vertex3 (-50) 50 0.0,
            Vertex3 (-50) (-50) 0.0,
            Vertex3 50 (-50) 0.0 :: Vertex3 GLfloat]
    
    --バッファの入れ替え
    swapBuffers

--タイマが呼ばれるたびにactを繰り返す
timerProc act = do
    act
    addTimerCallback timerInterval $ timerProc act

--ウィンドウのサイズが変更された時の処理
reshape (Size w h)=do
    viewport $= (Position 0 0, (Size w h)) --ウィンドウ全体を使う
    
    --ビューボリュームの設定-
    matrixMode $= Projection
    loadIdentity
    ortho 0.0 640.0 0.0 480.0 (-1000.0) 1000.0
    -- ortho2D 0.0 640.0 0.0 480.0
    
    matrixMode $= Modelview 0 -- これ大事
    
    {- --少し後ろから撮影
    lookAt (Vertex3 0.0 0.0 (600.0)) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)
    matrixMode $= Modelview 0 -}
    

--キー入力の処理
keyboardProc arg ch state _ _
    | ch     == Char 'q'    = exitWith ExitSuccess        --qが押されたら終了
    | ch    == Char 'a'     = modifyIORef arg (*(2))
    | ch    == Char 's'     = modifyIORef arg (*(0.5))
    | state    == Down        = modifyIORef arg (*(-1))    --それ以外なら回転の方向を変える
    | otherwise            = return ()

AOJ 0090 Overlaps of Seals

問題の内容

10*10の正方形上に半径1の円をn個(n<=100)配置する。
最も多くの円の内部に含まれる正方形上の点はいくつの円に含まれるか。
（円の内部とは円周上も含む。）

解法

想定解法では任意の二つの円についてその交点を求め
いくつの円に含まれるかを数えるらしい。

AOJ : 0090 - Overlaps of Seals - Respect2Dの日記
AOJ Problem 0090 : Overlaps of Seals - kyuridenamidaのチラ裏
AOJ 0090: Overlaps of Seals：Snowing day：So-net blog

嘘解法

正方形上の点をできるだけ多く列挙して
その一つ一つについていくつの円に含まれるかを調べる。
円に含まれるかどうかの判定を甘くすると通った。

ソース

#include <stdio.h>
#include <string.h>
#include <algorithm>
#include <vector>
#include <iostream>
#include <map>
#include <set>
using namespace std;
typedef long long LL;
double x[100],y[100];
int main(){
    int n;
    while(1){
        scanf("%d",&n);
        if(n==0)    break;
        for(int i=0;i<n;i++)
            scanf("%lf,%lf\n",&x[i],&y[i]);
        int ans=0;
        for(double a=0;a<=10.1;a+=0.01)
            for(double b=0;b<=10.1;b+=0.01){
                int t=0;
                for(int i=0;i<n;i++)
                    if((a-x[i])*(a-x[i])+(b-y[i])*(b-y[i])<=1.001)
                        t++;
                ans=max(ans,t);
            }
        printf("%d\n",ans);
    }
    return 0;
}

cabal install monadius したら結構ハマった

結局こんなことをやった

cabal install OpenGLRaw --reinstall
cabal install StateVar --reinstall
cabal install Tensor --reinstall
cabal install ObjectName --reinstall
cabal install OpenGL --reinstall
cabal install GLURaw --reinstall
cabal install array-0.3.0.1 --reinstall
cabal install containers --reinstall
cabal install GLUT --reinstall
cabal install directory-1.1.0.0 --reinstall
cabal install monadius --reinstall

  • history からインストールに必要だと思われるコマンドを抜粋した。
  • よく分からないのでとりあえず全部 --reinstall フラグをつけているけど要らないと思う。

ハマりポイント

cabal install array-0.3.0.1 --reinstall
cabal install directory-1.1.0.0 --reinstall

  • "cabal install array"だけでバージョン指定をしなかったり、"cabal install directory"だけだと最新版を入れようとしてくれるが、入らない。

Haskellで文字列圧縮(エンコーダーのみ）

仕組み

  • 各文字の出現頻度を数えて一番多いものに"1"、二番目に"01"、三番目に"001"を割り振る。
  • ex "aaaaaaaaaaaa" -> "11111111111"
  • その後6ビットずつに区切る
  • ex "11111111111" -> ["111111","111111"]
  • 2進数として読み、文字に変換する
  • ex ["111111","111111"] -> "``"

動作例

Main> compress "aaaaaaaaaaaaabbbbbbbbbbbbbb"
Just "KKKK_`0"
Main> compress "qwerrfvghhvjnbknjkfaghjgfjda"
Just "!1!%!%%%B5B\"#!)A!$)#1;C\"!#1"

課題

文字の種類が多いものはうまく圧縮できない。
生成したビット列の長さが6で割りきれないときは勝手に0を補っている。
返り値が Maybe String 。
デコーダがない。（致命的）

ソースコード

import Data.Map as M
import Data.List
import Data.Char

allChar = Prelude.map chr [0..127]

genDict str = fromList $ Prelude.map func $ zip [1..] $ Prelude.map snd $ reverse $ sort $ zip (Prelude.map (countChar str) allChar) allChar
	where 
		func (a,b) = (b,makeCodeLengthN a)
		makeCodeLengthN 1 = "1"
		makeCodeLengthN n = '0' : makeCodeLengthN (n-1)
		countChar [] _ = 0
		countChar (x:xs) c = if x==c
			then 1 + countChar xs c
			else countChar xs c

translate [] d = return []
translate (x:xs) d = do
	y <- M.lookup x d
	ys <- translate xs d
	return (y++ys)

bitToChar str = func (reverse str) 0
	where
		func [] a = chr (33+a)
		func (x:xs) a = if x=='1'
			then func xs (a*2+1)
			else func xs (a*2)

split6 str = if length str < 6
	then [str]
	else fst (splitAt 6 str) : split6 (snd (splitAt 6 str) )

compress str = do
	a <- translate str $ genDict str
	return ( Prelude.map bitToChar (split6 a) )