More code therapy.
This commit is contained in:
Eli Barzilay
parent
08174ec5e4
commit
4f13b3f1d5
|
|
@ -1,169 +1,99 @@
|
|||
; -*- Scheme -*-
|
||||
;; -*- Scheme -*-
|
||||
|
||||
(module array racket
|
||||
#lang racket
|
||||
|
||||
(provide array-make array-ref array-set!
|
||||
array-mult array-mult-vector
|
||||
array-det array-sub array-inv
|
||||
)
|
||||
array-det array-sub array-inv)
|
||||
|
||||
|
||||
; creates a square matrix, nxn
|
||||
;; creates a square matrix, nxn
|
||||
(define (array-make n)
|
||||
(let*
|
||||
( (a (make-vector n #f)) )
|
||||
(do ((i 0 (+ i 1))) ((= i n))
|
||||
(vector-set! a i (make-vector n 0.0))
|
||||
)
|
||||
a
|
||||
)
|
||||
)
|
||||
(define a (make-vector n #f))
|
||||
(for ([i (in-range n)])
|
||||
(vector-set! a i (make-vector n 0.0)))
|
||||
a)
|
||||
|
||||
; returns an array element
|
||||
;; returns an array element
|
||||
(define (array-ref m i j)
|
||||
(vector-ref (vector-ref m i) j)
|
||||
)
|
||||
(vector-ref (vector-ref m i) j))
|
||||
|
||||
; sets an array element
|
||||
;; sets an array element
|
||||
(define (array-set! m i j val)
|
||||
(let*
|
||||
( (vect (vector-ref m i)) )
|
||||
(vector-set! vect j val)
|
||||
)
|
||||
)
|
||||
(vector-set! (vector-ref m i) j val))
|
||||
|
||||
; matrix - matrix multiplication
|
||||
;; matrix - matrix multiplication
|
||||
(define (array-mult a b)
|
||||
(let*
|
||||
( (n (vector-length a))
|
||||
(m (array-make n))
|
||||
)
|
||||
(do ((i 0 (+ i 1))) ((= i n))
|
||||
(do ((j 0 (+ j 1))) ((= j n))
|
||||
(do ((k 0 (+ k 1))) ((= k n))
|
||||
(array-set! m i j (+ (array-ref m i j)
|
||||
(* (array-ref a i k)
|
||||
(array-ref b k j))))
|
||||
)
|
||||
)
|
||||
)
|
||||
m
|
||||
)
|
||||
)
|
||||
(define n (vector-length a))
|
||||
(define m (array-make n))
|
||||
(for* ([i (in-range n)]
|
||||
[j (in-range n)]
|
||||
[k (in-range n)])
|
||||
(array-set! m i j (+ (array-ref m i j)
|
||||
(* (array-ref a i k)
|
||||
(array-ref b k j)))))
|
||||
m)
|
||||
|
||||
; vector - matrix multiplication
|
||||
;; vector - matrix multiplication
|
||||
(define (array-mult-vector m v)
|
||||
(let* ( (r (make-vector 4 0)) )
|
||||
(do ((i 0 (+ 1 i))) ((= i 4))
|
||||
(do ((j 0 (+ 1 j))) ((= j 4))
|
||||
(vector-set! r
|
||||
i
|
||||
(+ (* (array-ref m i j) (vector-ref v j))
|
||||
(vector-ref r i)))
|
||||
)
|
||||
)
|
||||
r
|
||||
)
|
||||
)
|
||||
(define r (make-vector 4 0))
|
||||
(for* ([i (in-range 4)]
|
||||
[j (in-range 4)])
|
||||
(vector-set! r i (+ (* (array-ref m i j) (vector-ref v j))
|
||||
(vector-ref r i))))
|
||||
r)
|
||||
|
||||
; calculates the determinant of a matrix
|
||||
;; calculates the determinant of a matrix
|
||||
(define (array-det a)
|
||||
(cond
|
||||
( (= (vector-length a) 1)
|
||||
(array-ref a 0 0)
|
||||
)
|
||||
( (= (vector-length a) 2)
|
||||
(- (* (array-ref a 0 0) (array-ref a 1 1))
|
||||
(* (array-ref a 1 0) (array-ref a 0 1)) )
|
||||
)
|
||||
( else
|
||||
(let*
|
||||
( (n (vector-length a))
|
||||
(det 0.0)
|
||||
(m #f)
|
||||
(j2 #f)
|
||||
)
|
||||
(do ((j1 0 (+ j1 1))) ((= j1 n))
|
||||
; create sub-matrix
|
||||
(set! m (array-make (- n 1)))
|
||||
(do ((i 1 (+ i 1))) ((= i n))
|
||||
(set! j2 0)
|
||||
(do ((j 0 (+ j 1))) ((= j n))
|
||||
(when (not (= j j1))
|
||||
(begin
|
||||
(array-set! m (- i 1) j2 (array-ref a i j))
|
||||
(set! j2 (+ j2 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! det (+ det (* (expt -1 (+ 1 j1 1))
|
||||
(array-ref a 0 j1)
|
||||
(array-det m)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
; return the determinant
|
||||
det
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(cond [(= (vector-length a) 1)
|
||||
(array-ref a 0 0)]
|
||||
[(= (vector-length a) 2)
|
||||
(- (* (array-ref a 0 0) (array-ref a 1 1))
|
||||
(* (array-ref a 1 0) (array-ref a 0 1)))]
|
||||
[else
|
||||
(define n (vector-length a))
|
||||
(define det 0.0)
|
||||
(define m #f)
|
||||
(define j2 #f)
|
||||
(for ([j1 (in-range n)])
|
||||
;; create sub-matrix
|
||||
(set! m (array-make (- n 1)))
|
||||
(for ([i (in-range 1 n)])
|
||||
(set! j2 0)
|
||||
(for ([j (in-range n)] #:unless (= j j1))
|
||||
(array-set! m (- i 1) j2 (array-ref a i j))
|
||||
(set! j2 (+ j2 1))))
|
||||
(set! det (+ det (* (expt -1 (+ 1 j1 1))
|
||||
(array-ref a 0 j1)
|
||||
(array-det m)))))
|
||||
;; return the determinant
|
||||
det]))
|
||||
|
||||
; creates a sub-matrix, except row 'in' and column 'jn'
|
||||
;; creates a sub-matrix, except row 'in' and column 'jn'
|
||||
(define (array-sub a in jn)
|
||||
(let*
|
||||
( (n (vector-length a))
|
||||
(m (array-make (- n 1)))
|
||||
(ii 0)
|
||||
(jj 0)
|
||||
)
|
||||
(do ((i 0 (+ i 1))) ((= i n))
|
||||
(when (not (= i in))
|
||||
(begin
|
||||
(set! jj 0)
|
||||
(do ((j 0 (+ j 1))) ((= j n))
|
||||
(when (not (= j jn))
|
||||
(begin
|
||||
(array-set! m ii jj (array-ref a i j))
|
||||
(set! jj (+ jj 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! ii (+ ii 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
m
|
||||
)
|
||||
)
|
||||
(define n (vector-length a))
|
||||
(define m (array-make (- n 1)))
|
||||
(define ii 0)
|
||||
(define jj 0)
|
||||
(for ([i (in-range n)] #:unless (= i in))
|
||||
(set! jj 0)
|
||||
(for ([j (in-range n)] #:unless (= j jn))
|
||||
(array-set! m ii jj (array-ref a i j))
|
||||
(set! jj (+ jj 1)))
|
||||
(set! ii (+ ii 1)))
|
||||
m)
|
||||
|
||||
; calculates the inverse of a matrix
|
||||
;; calculates the inverse of a matrix
|
||||
(define (array-inv a)
|
||||
(let*
|
||||
( (n (vector-length a))
|
||||
(m (array-make n))
|
||||
(det (array-det a))
|
||||
)
|
||||
(do ((i 0 (+ i 1))) ((= i n))
|
||||
(do ((j 0 (+ j 1))) ((= j n))
|
||||
(array-set! m j i (/ (* (expt -1 (+ i j))
|
||||
(array-det (array-sub a i j))
|
||||
)
|
||||
det))
|
||||
)
|
||||
)
|
||||
m
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
; (define aa '#( #( 1 2 3) #( 4 4 0) #( 0 0 10) ) )
|
||||
; (define bb (array-inv aa))
|
||||
; (array-mult aa bb)
|
||||
|
||||
) ; end of module
|
||||
|
||||
(define n (vector-length a))
|
||||
(define m (array-make n))
|
||||
(define det (array-det a))
|
||||
(for* ([i (in-range n)]
|
||||
[j (in-range n)])
|
||||
(array-set! m j i (/ (* (expt -1 (+ i j))
|
||||
(array-det (array-sub a i j)))
|
||||
det)))
|
||||
m)
|
||||
|
||||
;; (define aa '#(#(1 2 3) #(4 4 0) #(0 0 10)))
|
||||
;; (define bb (array-inv aa))
|
||||
;; (array-mult aa bb)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -1,186 +1,157 @@
|
|||
(module text racket
|
||||
#lang racket/base
|
||||
|
||||
(require racket
|
||||
racket/class
|
||||
sgl/gl
|
||||
sgl/gl-vectors
|
||||
)
|
||||
|
||||
(provide string-init string-draw)
|
||||
|
||||
; HERSHEY fonts
|
||||
(define hershey-fonts
|
||||
'#( (#\A "MWRMNV RRMVV RPSTS")
|
||||
(#\B "MWOMOV ROMSMUNUPSQ ROQSQURUUSVOV")
|
||||
(#\C "MXVNTMRMPNOPOSPURVTVVU")
|
||||
(#\D "MWOMOV ROMRMTNUPUSTURVOV")
|
||||
(#\E "MWOMOV ROMUM ROQSQ ROVUV")
|
||||
(#\F "MVOMOV ROMUM ROQSQ")
|
||||
(#\G "MXVNTMRMPNOPOSPURVTVVUVR RSRVR")
|
||||
(#\H "MWOMOV RUMUV ROQUQ")
|
||||
(#\I "MTRMRV") ; modified
|
||||
(#\J "NUSMSTRVPVOTOS")
|
||||
(#\K "MWOMOV RUMOS RQQUV")
|
||||
(#\L "MVOMOV ROVUV")
|
||||
(#\M "LXNMNV RNMRV RVMRV RVMVV")
|
||||
(#\N "MWOMOV ROMUV RUMUV")
|
||||
(#\O "MXRMPNOPOSPURVSVUUVSVPUNSMRM")
|
||||
(#\P "MWOMOV ROMSMUNUQSROR")
|
||||
(#\Q "MXRMPNOPOSPURVSVUUVSVPUNSMRM RSTVW")
|
||||
(#\R "MWOMOV ROMSMUNUQSROR RRRUV")
|
||||
(#\S "MWUNSMQMONOOPPTRUSUUSVQVOU")
|
||||
(#\T "MWRMRV RNMVM")
|
||||
(#\U "MXOMOSPURVSVUUVSVM")
|
||||
(#\V "MWNMRV RVMRV")
|
||||
(#\W "LXNMPV RRMPV RRMTV RVMTV")
|
||||
(#\X "MWOMUV RUMOV")
|
||||
(#\Y "MWNMRQRV RVMRQ")
|
||||
(#\Z "MWUMOV ROMUM ROVUV")
|
||||
(#\space "LX")
|
||||
; numbers
|
||||
(#\0 "MWRMPNOPOSPURVTUUSUPTNRM")
|
||||
(#\1 "MWPORMRV")
|
||||
(#\2 "MWONQMSMUNUPTROVUV")
|
||||
(#\3 "MWONQMSMUNUPSQ RRQSQURUUSVQVOU")
|
||||
(#\4 "MWSMSV RSMNSVS")
|
||||
(#\5 "MWPMOQQPRPTQUSTURVQVOU RPMTM")
|
||||
(#\6 "MWTMRMPNOPOSPURVTUUSTQRPPQOS")
|
||||
(#\7 "MWUMQV ROMUM")
|
||||
(#\8 "MWQMONOPQQSQUPUNSMQM RQQOROUQVSVUUURSQ")
|
||||
(#\9 "MWUPTRRSPROPPNRMTNUPUSTURVPV")
|
||||
; signs
|
||||
(#\- "LXNRVR")
|
||||
(#\+ "LXRNRV RNRVR")
|
||||
; !!!!! this must exist !!!!!
|
||||
(#\* "MWRORU ROPUT RUPOT")
|
||||
(require racket/class sgl/gl sgl/gl-vectors)
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
; font database is a hash table
|
||||
(define font-db (make-hash))
|
||||
(define font-gen #f)
|
||||
(define font-scale #f)
|
||||
|
||||
(define (real->int val)
|
||||
(inexact->exact (round val))
|
||||
)
|
||||
|
||||
; interpret a hershey font
|
||||
(define (interpret-hershey str scale)
|
||||
(let*
|
||||
( (nc (/ (string-length str) 2))
|
||||
(cx #f) (cy #f) (x #f) (y #f)
|
||||
(left (char->integer (string-ref str 0)))
|
||||
(right (char->integer (string-ref str 1)))
|
||||
(rchar (char->integer #\R))
|
||||
)
|
||||
(set! left (- left rchar))
|
||||
(set! right (- right rchar))
|
||||
|
||||
(glBegin GL_LINE_STRIP)
|
||||
(do ((i 1 (+ i 1))) ((= i nc))
|
||||
(set! cx (string-ref str (+ (* i 2) 0)))
|
||||
(set! cy (string-ref str (+ (* i 2) 1)))
|
||||
(if (and (char=? cx #\space)
|
||||
(char=? cy #\R))
|
||||
(begin
|
||||
(glEnd)
|
||||
(glBegin GL_LINE_STRIP)
|
||||
)
|
||||
(begin
|
||||
(set! x (* (- (char->integer cx) rchar) scale) )
|
||||
(set! y (* (- (char->integer cy) rchar) scale) )
|
||||
(glVertex2f x (- y))
|
||||
)
|
||||
)
|
||||
)
|
||||
(glEnd)
|
||||
|
||||
; width of the font
|
||||
(- right left)
|
||||
)
|
||||
)
|
||||
(provide string-init string-draw)
|
||||
|
||||
|
||||
; initialise the font database
|
||||
(define (string-init scale)
|
||||
(let*
|
||||
( (n (vector-length hershey-fonts))
|
||||
(elem #f)
|
||||
(width #f)
|
||||
)
|
||||
|
||||
(set! font-scale scale)
|
||||
(set! font-gen (glGenLists n))
|
||||
(glLineWidth 2.0)
|
||||
|
||||
(do ((i 0 (+ i 1))) ((= i n))
|
||||
(set! elem (vector-ref hershey-fonts i))
|
||||
(glNewList (+ font-gen i) GL_COMPILE)
|
||||
(set! width (interpret-hershey (cadr elem) scale))
|
||||
(glEndList)
|
||||
|
||||
(hash-set! font-db (car elem) (cons i width))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
; draw the text
|
||||
(define (string-draw str)
|
||||
(let*
|
||||
( (n (string-length str))
|
||||
(c #f) (e #f)
|
||||
(star (hash-ref font-db #\*))
|
||||
)
|
||||
(glPushMatrix)
|
||||
(glNormal3f 0.0 0.0 1.0)
|
||||
(do ((i 0 (+ i 1))) ((= i n))
|
||||
(set! c (string-ref str i))
|
||||
(set! e (hash-ref font-db c (lambda () star) ))
|
||||
(glCallList (+ font-gen (car e)))
|
||||
(glTranslatef (* font-scale (cdr e)) 0.0 0.0)
|
||||
)
|
||||
(glPopMatrix)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
; -------------------------------------------------------
|
||||
; Testing
|
||||
|
||||
#|
|
||||
(define *GL_VIEWPORT_WIDTH* #f)
|
||||
(define *GL_VIEWPORT_HEIGHT* #f)
|
||||
(define scale 1.5)
|
||||
(define bit '#(1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1))
|
||||
|
||||
(define (my-display)
|
||||
(glMatrixMode GL_PROJECTION)
|
||||
(glLoadIdentity)
|
||||
(glOrtho 0 *GL_VIEWPORT_WIDTH* 0 *GL_VIEWPORT_HEIGHT* -1 1)
|
||||
|
||||
(glMatrixMode GL_MODELVIEW)
|
||||
(glLoadIdentity)
|
||||
|
||||
(glTranslatef (/ *GL_VIEWPORT_WIDTH* 2)
|
||||
(/ *GL_VIEWPORT_HEIGHT* 2)
|
||||
0.0)
|
||||
(string-draw "+12" scale)
|
||||
; (glRasterPos2i 50 50)
|
||||
;(glBitmap 8 8 0.0 0.0 8.0 0.0 (vector->gl-ubyte-vector bit))
|
||||
)
|
||||
|
||||
|
||||
(define my-canvas%
|
||||
;; HERSHEY fonts
|
||||
(define hershey-fonts
|
||||
'#( (#\A "MWRMNV RRMVV RPSTS")
|
||||
(#\B "MWOMOV ROMSMUNUPSQ ROQSQURUUSVOV")
|
||||
(#\C "MXVNTMRMPNOPOSPURVTVVU")
|
||||
(#\D "MWOMOV ROMRMTNUPUSTURVOV")
|
||||
(#\E "MWOMOV ROMUM ROQSQ ROVUV")
|
||||
(#\F "MVOMOV ROMUM ROQSQ")
|
||||
(#\G "MXVNTMRMPNOPOSPURVTVVUVR RSRVR")
|
||||
(#\H "MWOMOV RUMUV ROQUQ")
|
||||
(#\I "MTRMRV") ; modified
|
||||
(#\J "NUSMSTRVPVOTOS")
|
||||
(#\K "MWOMOV RUMOS RQQUV")
|
||||
(#\L "MVOMOV ROVUV")
|
||||
(#\M "LXNMNV RNMRV RVMRV RVMVV")
|
||||
(#\N "MWOMOV ROMUV RUMUV")
|
||||
(#\O "MXRMPNOPOSPURVSVUUVSVPUNSMRM")
|
||||
(#\P "MWOMOV ROMSMUNUQSROR")
|
||||
(#\Q "MXRMPNOPOSPURVSVUUVSVPUNSMRM RSTVW")
|
||||
(#\R "MWOMOV ROMSMUNUQSROR RRRUV")
|
||||
(#\S "MWUNSMQMONOOPPTRUSUUSVQVOU")
|
||||
(#\T "MWRMRV RNMVM")
|
||||
(#\U "MXOMOSPURVSVUUVSVM")
|
||||
(#\V "MWNMRV RVMRV")
|
||||
(#\W "LXNMPV RRMPV RRMTV RVMTV")
|
||||
(#\X "MWOMUV RUMOV")
|
||||
(#\Y "MWNMRQRV RVMRQ")
|
||||
(#\Z "MWUMOV ROMUM ROVUV")
|
||||
(#\space "LX")
|
||||
;; numbers
|
||||
(#\0 "MWRMPNOPOSPURVTUUSUPTNRM")
|
||||
(#\1 "MWPORMRV")
|
||||
(#\2 "MWONQMSMUNUPTROVUV")
|
||||
(#\3 "MWONQMSMUNUPSQ RRQSQURUUSVQVOU")
|
||||
(#\4 "MWSMSV RSMNSVS")
|
||||
(#\5 "MWPMOQQPRPTQUSTURVQVOU RPMTM")
|
||||
(#\6 "MWTMRMPNOPOSPURVTUUSTQRPPQOS")
|
||||
(#\7 "MWUMQV ROMUM")
|
||||
(#\8 "MWQMONOPQQSQUPUNSMQM RQQOROUQVSVUUURSQ")
|
||||
(#\9 "MWUPTRRSPROPPNRMTNUPUSTURVPV")
|
||||
;; signs
|
||||
(#\- "LXNRVR")
|
||||
(#\+ "LXRNRV RNRVR")
|
||||
;; !!!!! this must exist !!!!!
|
||||
(#\* "MWRORU ROPUT RUPOT")
|
||||
))
|
||||
|
||||
;; font database is a hash table
|
||||
(define font-db (make-hash))
|
||||
(define font-gen #f)
|
||||
(define font-scale #f)
|
||||
|
||||
(define (real->int val)
|
||||
(inexact->exact (round val)))
|
||||
|
||||
;; interpret a hershey font
|
||||
(define (interpret-hershey str scale)
|
||||
(let* ([nc (/ (string-length str) 2)]
|
||||
[cx #f] [cy #f] [x #f] [y #f]
|
||||
[left (char->integer (string-ref str 0))]
|
||||
[right (char->integer (string-ref str 1))]
|
||||
[rchar (char->integer #\R)])
|
||||
(set! left (- left rchar))
|
||||
(set! right (- right rchar))
|
||||
|
||||
(glBegin GL_LINE_STRIP)
|
||||
(for ([i (in-range 1 nc)])
|
||||
(set! cx (string-ref str (+ (* i 2) 0)))
|
||||
(set! cy (string-ref str (+ (* i 2) 1)))
|
||||
(if (and (char=? cx #\space)
|
||||
(char=? cy #\R))
|
||||
(begin (glEnd)
|
||||
(glBegin GL_LINE_STRIP))
|
||||
(begin (set! x (* (- (char->integer cx) rchar) scale))
|
||||
(set! y (* (- (char->integer cy) rchar) scale))
|
||||
(glVertex2f x (- y)))))
|
||||
(glEnd)
|
||||
|
||||
;; width of the font
|
||||
(- right left)))
|
||||
|
||||
|
||||
;; initialise the font database
|
||||
(define (string-init scale)
|
||||
(let* ([n (vector-length hershey-fonts)]
|
||||
[elem #f]
|
||||
[width #f])
|
||||
|
||||
(set! font-scale scale)
|
||||
(set! font-gen (glGenLists n))
|
||||
(glLineWidth 2.0)
|
||||
|
||||
(for ([i (in-range n)])
|
||||
(set! elem (vector-ref hershey-fonts i))
|
||||
(glNewList (+ font-gen i) GL_COMPILE)
|
||||
(set! width (interpret-hershey (cadr elem) scale))
|
||||
(glEndList)
|
||||
|
||||
(hash-set! font-db (car elem) (cons i width)))))
|
||||
|
||||
;; draw the text
|
||||
(define (string-draw str)
|
||||
(let* ([n (string-length str)]
|
||||
[c #f] [e #f]
|
||||
[star (hash-ref font-db #\*)])
|
||||
(glPushMatrix)
|
||||
(glNormal3f 0.0 0.0 1.0)
|
||||
(for ([i (in-range n)])
|
||||
(set! c (string-ref str i))
|
||||
(set! e (hash-ref font-db c (lambda () star)))
|
||||
(glCallList (+ font-gen (car e)))
|
||||
(glTranslatef (* font-scale (cdr e)) 0.0 0.0))
|
||||
(glPopMatrix)))
|
||||
|
||||
|
||||
;; -------------------------------------------------------
|
||||
;; Testing
|
||||
|
||||
#|
|
||||
(define *GL_VIEWPORT_WIDTH* #f)
|
||||
(define *GL_VIEWPORT_HEIGHT* #f)
|
||||
(define scale 1.5)
|
||||
(define bit '#(1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1
|
||||
1 1 1 1 1 1 1 1))
|
||||
|
||||
(define (my-display)
|
||||
(glMatrixMode GL_PROJECTION)
|
||||
(glLoadIdentity)
|
||||
(glOrtho 0 *GL_VIEWPORT_WIDTH* 0 *GL_VIEWPORT_HEIGHT* -1 1)
|
||||
|
||||
(glMatrixMode GL_MODELVIEW)
|
||||
(glLoadIdentity)
|
||||
|
||||
(glTranslatef (/ *GL_VIEWPORT_WIDTH* 2)
|
||||
(/ *GL_VIEWPORT_HEIGHT* 2)
|
||||
0.0)
|
||||
(string-draw "+12" scale)
|
||||
;; (glRasterPos2i 50 50)
|
||||
;; (glBitmap 8 8 0.0 0.0 8.0 0.0 (vector->gl-ubyte-vector bit))
|
||||
)
|
||||
|
||||
(define my-canvas%
|
||||
(class* canvas% ()
|
||||
(inherit with-gl-context swap-gl-buffers)
|
||||
|
||||
|
|
@ -192,39 +163,24 @@
|
|||
(glClear GL_DEPTH_BUFFER_BIT)
|
||||
|
||||
(my-display)
|
||||
(swap-gl-buffers)
|
||||
)
|
||||
)
|
||||
)
|
||||
(swap-gl-buffers))))
|
||||
|
||||
(define/override (on-size width height)
|
||||
(with-gl-context
|
||||
(lambda ()
|
||||
(set! *GL_VIEWPORT_WIDTH* width)
|
||||
(set! *GL_VIEWPORT_HEIGHT* height)
|
||||
|
||||
(string-init scale)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(super-instantiate () (style '(gl)))
|
||||
)
|
||||
)
|
||||
(string-init scale))))
|
||||
|
||||
; initialise fonts
|
||||
|
||||
(let*
|
||||
( (f (make-object frame% "Font test" #f))
|
||||
(w (instantiate my-canvas% (f)
|
||||
(min-width 300)
|
||||
(min-height 100)))
|
||||
)
|
||||
(super-instantiate () (style '(gl)))))
|
||||
|
||||
(send f show #t)
|
||||
)
|
||||
|#
|
||||
|
||||
) ; end of module
|
||||
;; initialise fonts
|
||||
|
||||
(let* ([f (make-object frame% "Font test" #f)]
|
||||
[w (instantiate my-canvas% (f)
|
||||
(min-width 300)
|
||||
(min-height 100))])
|
||||
|
||||
(send f show #t))
|
||||
|#
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user