From 73dcd471279fb6cc58e944fb56ad863955eb742e Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Fri, 22 Sep 2017 21:47:25 +0300 Subject: [PATCH] moved Holmes UI and most of it's low-level gfx subsystem to separate modules (to ease UI developing and testing) --- src/game/Doom2DF.dpr | 5 +- src/game/g_holmes.inc | 942 ++---------- src/game/g_holmes.pas | 384 +---- src/game/g_window.pas | 176 +-- src/{game/g_holmes_ui.inc => gx/gh_ui.pas} | 280 ++-- src/gx/glgfx.pas | 1504 ++++++++++++++++++++ src/gx/sdlcarcass.pas | 57 + 7 files changed, 1911 insertions(+), 1437 deletions(-) rename src/{game/g_holmes_ui.inc => gx/gh_ui.pas} (84%) create mode 100644 src/gx/glgfx.pas create mode 100644 src/gx/sdlcarcass.pas diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 53d66f1..67dcc03 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -110,7 +110,10 @@ uses g_language in 'g_language.pas', ImagingTypes, Imaging, - ImagingUtility; + ImagingUtility, + sdlcarcass in '../gx/sdlcarcass.pas', + glgfx in '../gx/glgfx.pas', + gh_ui in '../gx/gh_ui.pas'; {$IFDEF WINDOWS} {$R *.res} diff --git a/src/game/g_holmes.inc b/src/game/g_holmes.inc index 82ecc94..15678df 100644 --- a/src/game/g_holmes.inc +++ b/src/game/g_holmes.inc @@ -13,829 +13,6 @@ * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) -// ////////////////////////////////////////////////////////////////////////// // -// cursor (hi, Death Track!) -const curTexWidth = 32; -const curTexHeight = 32; -const curWidth = 17; -const curHeight = 23; - -const cursorImg: array[0..curWidth*curHeight-1] of Byte = ( - 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 3,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 3,3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0, - 3,3,4,2,2,0,0,0,0,0,0,0,0,0,0,0,0, - 3,3,4,4,2,2,0,0,0,0,0,0,0,0,0,0,0, - 3,3,4,4,4,2,2,0,0,0,0,0,0,0,0,0,0, - 3,3,4,4,4,4,2,2,0,0,0,0,0,0,0,0,0, - 3,3,4,4,4,5,6,2,2,0,0,0,0,0,0,0,0, - 3,3,4,4,5,6,7,5,2,2,0,0,0,0,0,0,0, - 3,3,4,5,6,7,5,4,5,2,2,0,0,0,0,0,0, - 3,3,5,6,7,5,4,5,6,7,2,2,0,0,0,0,0, - 3,3,6,7,5,4,5,6,7,7,7,2,2,0,0,0,0, - 3,3,7,5,4,5,6,7,7,7,7,7,2,2,0,0,0, - 3,3,5,4,5,6,8,8,8,8,8,8,8,8,2,0,0, - 3,3,4,5,6,3,8,8,8,8,8,8,8,8,8,0,0, - 3,3,5,6,3,3,0,0,0,0,0,0,0,0,0,0,0, - 3,3,6,3,3,0,0,0,0,0,0,0,0,0,0,0,0, - 3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0, - 3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 -); -const cursorPal: array[0..9*4-1] of Byte = ( - 0, 0, 0, 0, - 0, 0, 0,163, - 85,255,255,255, - 85, 85,255,255, - 255, 85, 85,255, - 170, 0,170,255, - 85, 85, 85,255, - 0, 0, 0,255, - 0, 0,170,255 -); - - -var - curtexid: GLuint = 0; - -procedure createCursorTexture (); -var - tex, tpp: PByte; - c: Integer; - x, y: Integer; -begin - if (curtexid <> 0) then exit; //begin glDeleteTextures(1, @curtexid); curtexid := 0; end; - - GetMem(tex, curTexWidth*curTexHeight*4); - FillChar(tex^, curTexWidth*curTexHeight*4, 0); - - // draw shadow - for y := 0 to curHeight-1 do - begin - for x := 0 to curWidth-1 do - begin - if (cursorImg[y*curWidth+x] <> 0) then - begin - c := 1*4; - tpp := tex+((y+1)*(curTexWidth*4)+(x+3)*4); - tpp^ := cursorPal[c+0]; Inc(tpp); - tpp^ := cursorPal[c+1]; Inc(tpp); - tpp^ := cursorPal[c+2]; Inc(tpp); - tpp^ := cursorPal[c+3]; Inc(tpp); - tpp^ := cursorPal[c+0]; Inc(tpp); - tpp^ := cursorPal[c+1]; Inc(tpp); - tpp^ := cursorPal[c+2]; Inc(tpp); - tpp^ := cursorPal[c+3]; Inc(tpp); - end; - end; - end; - - // draw cursor - for y := 0 to curHeight-1 do - begin - for x := 0 to curWidth-1 do - begin - c := cursorImg[y*curWidth+x]*4; - if (c <> 0) then - begin - tpp := tex+(y*(curTexWidth*4)+x*4); - tpp^ := cursorPal[c+0]; Inc(tpp); - tpp^ := cursorPal[c+1]; Inc(tpp); - tpp^ := cursorPal[c+2]; Inc(tpp); - tpp^ := cursorPal[c+3]; Inc(tpp); - end; - end; - end; - - glGenTextures(1, @curtexid); - if (curtexid = 0) then raise Exception.Create('can''t create Holmes texture'); - - glBindTexture(GL_TEXTURE_2D, curtexid); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); - - //GLfloat[4] bclr = 0.0; - //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr); - - glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, curTexWidth, curTexHeight, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex); - glFlush(); - - //FreeMem(tex); -end; - - -procedure drawCursor (); -begin - if (curtexid = 0) then createCursorTexture() else glBindTexture(GL_TEXTURE_2D, curtexid); - // blend it - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_TEXTURE_2D); - // color and opacity - glColor4f(1, 1, 1, 0.9); - //Dec(msX, 2); - glBegin(GL_QUADS); - glTexCoord2f(0.0, 0.0); glVertex2i(msX, msY); // top-left - glTexCoord2f(1.0, 0.0); glVertex2i(msX+curTexWidth, msY); // top-right - glTexCoord2f(1.0, 1.0); glVertex2i(msX+curTexWidth, msY+curTexHeight); // bottom-right - glTexCoord2f(0.0, 1.0); glVertex2i(msX, msY+curTexHeight); // bottom-left - glEnd(); - //Inc(msX, 2); - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - glColor4f(1, 1, 1, 1); - glBindTexture(GL_TEXTURE_2D, 0); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -type - TScissorSave = record - public - wassc: Boolean; - scxywh: packed array[0..3] of GLint; - - public - procedure save (enableScissoring: Boolean); - procedure restore (); - end; - -procedure TScissorSave.save (enableScissoring: Boolean); -begin - wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0); - if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]); - //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]); - if enableScissoring then glEnable(GL_SCISSOR_TEST); -end; - - -procedure TScissorSave.restore (); -begin - glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]); - if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -// fonts -const kgiFont6: array[0..256*8-1] of Byte = ( -$00,$00,$00,$00,$00,$00,$00,$00,$3c,$42,$a5,$81,$a5,$99,$42,$3c,$3c,$7e,$db,$ff,$ff,$db,$66,$3c,$6c,$fe, -$fe,$fe,$7c,$38,$10,$00,$10,$38,$7c,$fe,$7c,$38,$10,$00,$10,$38,$54,$fe,$54,$10,$38,$00,$10,$38,$7c,$fe, -$fe,$10,$38,$00,$00,$00,$00,$30,$30,$00,$00,$00,$ff,$ff,$ff,$e7,$e7,$ff,$ff,$ff,$38,$44,$82,$82,$82,$44, -$38,$00,$c7,$bb,$7d,$7d,$7d,$bb,$c7,$ff,$0f,$03,$05,$79,$88,$88,$88,$70,$38,$44,$44,$44,$38,$10,$7c,$10, -$30,$28,$24,$24,$28,$20,$e0,$c0,$3c,$24,$3c,$24,$24,$e4,$dc,$18,$10,$54,$38,$ee,$38,$54,$10,$00,$10,$10, -$10,$7c,$10,$10,$10,$10,$10,$10,$10,$ff,$00,$00,$00,$00,$00,$00,$00,$ff,$10,$10,$10,$10,$10,$10,$10,$f0, -$10,$10,$10,$10,$10,$10,$10,$1f,$10,$10,$10,$10,$10,$10,$10,$ff,$10,$10,$10,$10,$10,$10,$10,$10,$10,$10, -$10,$10,$00,$00,$00,$ff,$00,$00,$00,$00,$00,$00,$00,$1f,$10,$10,$10,$10,$00,$00,$00,$f0,$10,$10,$10,$10, -$10,$10,$10,$1f,$00,$00,$00,$00,$10,$10,$10,$f0,$00,$00,$00,$00,$81,$42,$24,$18,$18,$24,$42,$81,$01,$02, -$04,$08,$10,$20,$40,$80,$80,$40,$20,$10,$08,$04,$02,$01,$00,$10,$10,$ff,$10,$10,$00,$00,$00,$00,$00,$00, -$00,$00,$00,$00,$20,$20,$20,$20,$00,$00,$20,$00,$50,$50,$50,$00,$00,$00,$00,$00,$50,$50,$f8,$50,$f8,$50, -$50,$00,$20,$78,$a0,$70,$28,$f0,$20,$00,$c0,$c8,$10,$20,$40,$98,$18,$00,$40,$a0,$40,$a8,$90,$98,$60,$00, -$10,$20,$40,$00,$00,$00,$00,$00,$10,$20,$40,$40,$40,$20,$10,$00,$40,$20,$10,$10,$10,$20,$40,$00,$88,$50, -$20,$f8,$20,$50,$88,$00,$00,$20,$20,$f8,$20,$20,$00,$00,$00,$00,$00,$00,$00,$20,$20,$40,$00,$00,$00,$78, -$00,$00,$00,$00,$00,$00,$00,$00,$00,$60,$60,$00,$00,$00,$08,$10,$20,$40,$80,$00,$70,$88,$98,$a8,$c8,$88, -$70,$00,$20,$60,$a0,$20,$20,$20,$f8,$00,$70,$88,$08,$10,$60,$80,$f8,$00,$70,$88,$08,$30,$08,$88,$70,$00, -$10,$30,$50,$90,$f8,$10,$10,$00,$f8,$80,$e0,$10,$08,$10,$e0,$00,$30,$40,$80,$f0,$88,$88,$70,$00,$f8,$88, -$10,$20,$20,$20,$20,$00,$70,$88,$88,$70,$88,$88,$70,$00,$70,$88,$88,$78,$08,$10,$60,$00,$00,$00,$20,$00, -$00,$20,$00,$00,$00,$00,$20,$00,$00,$20,$20,$40,$18,$30,$60,$c0,$60,$30,$18,$00,$00,$00,$f8,$00,$f8,$00, -$00,$00,$c0,$60,$30,$18,$30,$60,$c0,$00,$70,$88,$08,$10,$20,$00,$20,$00,$70,$88,$08,$68,$a8,$a8,$70,$00, -$20,$50,$88,$88,$f8,$88,$88,$00,$f0,$48,$48,$70,$48,$48,$f0,$00,$30,$48,$80,$80,$80,$48,$30,$00,$e0,$50, -$48,$48,$48,$50,$e0,$00,$f8,$80,$80,$f0,$80,$80,$f8,$00,$f8,$80,$80,$f0,$80,$80,$80,$00,$70,$88,$80,$b8, -$88,$88,$70,$00,$88,$88,$88,$f8,$88,$88,$88,$00,$70,$20,$20,$20,$20,$20,$70,$00,$38,$10,$10,$10,$90,$90, -$60,$00,$88,$90,$a0,$c0,$a0,$90,$88,$00,$80,$80,$80,$80,$80,$80,$f8,$00,$88,$d8,$a8,$a8,$88,$88,$88,$00, -$88,$c8,$c8,$a8,$98,$98,$88,$00,$70,$88,$88,$88,$88,$88,$70,$00,$f0,$88,$88,$f0,$80,$80,$80,$00,$70,$88, -$88,$88,$a8,$90,$68,$00,$f0,$88,$88,$f0,$a0,$90,$88,$00,$70,$88,$80,$70,$08,$88,$70,$00,$f8,$20,$20,$20, -$20,$20,$20,$00,$88,$88,$88,$88,$88,$88,$70,$00,$88,$88,$88,$88,$50,$50,$20,$00,$88,$88,$88,$a8,$a8,$d8, -$88,$00,$88,$88,$50,$20,$50,$88,$88,$00,$88,$88,$88,$70,$20,$20,$20,$00,$f8,$08,$10,$20,$40,$80,$f8,$00, -$70,$40,$40,$40,$40,$40,$70,$00,$00,$00,$80,$40,$20,$10,$08,$00,$70,$10,$10,$10,$10,$10,$70,$00,$20,$50, -$88,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$f8,$00,$40,$20,$10,$00,$00,$00,$00,$00,$00,$00,$70,$08, -$78,$88,$78,$00,$80,$80,$b0,$c8,$88,$c8,$b0,$00,$00,$00,$70,$88,$80,$88,$70,$00,$08,$08,$68,$98,$88,$98, -$68,$00,$00,$00,$70,$88,$f8,$80,$70,$00,$10,$28,$20,$f8,$20,$20,$20,$00,$00,$00,$68,$98,$98,$68,$08,$70, -$80,$80,$f0,$88,$88,$88,$88,$00,$20,$00,$60,$20,$20,$20,$70,$00,$10,$00,$30,$10,$10,$10,$90,$60,$40,$40, -$48,$50,$60,$50,$48,$00,$60,$20,$20,$20,$20,$20,$70,$00,$00,$00,$d0,$a8,$a8,$a8,$a8,$00,$00,$00,$b0,$c8, -$88,$88,$88,$00,$00,$00,$70,$88,$88,$88,$70,$00,$00,$00,$b0,$c8,$c8,$b0,$80,$80,$00,$00,$68,$98,$98,$68, -$08,$08,$00,$00,$b0,$c8,$80,$80,$80,$00,$00,$00,$78,$80,$f0,$08,$f0,$00,$40,$40,$f0,$40,$40,$48,$30,$00, -$00,$00,$90,$90,$90,$90,$68,$00,$00,$00,$88,$88,$88,$50,$20,$00,$00,$00,$88,$a8,$a8,$a8,$50,$00,$00,$00, -$88,$50,$20,$50,$88,$00,$00,$00,$88,$88,$98,$68,$08,$70,$00,$00,$f8,$10,$20,$40,$f8,$00,$18,$20,$20,$40, -$20,$20,$18,$00,$20,$20,$20,$00,$20,$20,$20,$00,$c0,$20,$20,$10,$20,$20,$c0,$00,$40,$a8,$10,$00,$00,$00, -$00,$00,$00,$00,$20,$50,$f8,$00,$00,$00,$00,$00,$00,$00,$00,$00,$ff,$ff,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f, -$00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$00,$00,$00,$00,$00,$3c,$3c,$00,$00,$00,$ff,$ff, -$ff,$ff,$ff,$ff,$00,$00,$c0,$c0,$c0,$c0,$c0,$c0,$c0,$c0,$0f,$0f,$0f,$0f,$f0,$f0,$f0,$f0,$fc,$fc,$fc,$fc, -$fc,$fc,$fc,$fc,$03,$03,$03,$03,$03,$03,$03,$03,$3f,$3f,$3f,$3f,$3f,$3f,$3f,$3f,$11,$22,$44,$88,$11,$22, -$44,$88,$88,$44,$22,$11,$88,$44,$22,$11,$fe,$7c,$38,$10,$00,$00,$00,$00,$00,$00,$00,$00,$10,$38,$7c,$fe, -$80,$c0,$e0,$f0,$e0,$c0,$80,$00,$01,$03,$07,$0f,$07,$03,$01,$00,$ff,$7e,$3c,$18,$18,$3c,$7e,$ff,$81,$c3, -$e7,$ff,$ff,$e7,$c3,$81,$f0,$f0,$f0,$f0,$00,$00,$00,$00,$00,$00,$00,$00,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f, -$00,$00,$00,$00,$00,$00,$00,$00,$f0,$f0,$f0,$f0,$33,$33,$cc,$cc,$33,$33,$cc,$cc,$00,$20,$20,$50,$50,$88, -$f8,$00,$20,$20,$70,$20,$70,$20,$20,$00,$00,$00,$00,$50,$88,$a8,$50,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff, -$00,$00,$00,$00,$ff,$ff,$ff,$ff,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$ff,$ff, -$ff,$ff,$00,$00,$00,$00,$00,$00,$68,$90,$90,$90,$68,$00,$30,$48,$48,$70,$48,$48,$70,$c0,$f8,$88,$80,$80, -$80,$80,$80,$00,$00,$50,$70,$88,$f8,$80,$70,$00,$00,$00,$78,$80,$f0,$80,$78,$00,$00,$00,$78,$90,$90,$90, -$60,$00,$20,$00,$60,$20,$20,$20,$70,$00,$50,$00,$70,$20,$20,$20,$70,$00,$f8,$20,$70,$a8,$a8,$70,$20,$f8, -$20,$50,$88,$f8,$88,$50,$20,$00,$70,$88,$88,$88,$50,$50,$d8,$00,$30,$40,$40,$20,$50,$50,$50,$20,$00,$00, -$00,$50,$a8,$a8,$50,$00,$08,$70,$a8,$a8,$a8,$70,$80,$00,$38,$40,$80,$f8,$80,$40,$38,$00,$70,$88,$88,$88, -$88,$88,$88,$00,$00,$f8,$00,$f8,$00,$f8,$00,$00,$20,$20,$f8,$20,$20,$00,$f8,$00,$c0,$30,$08,$30,$c0,$00, -$f8,$00,$50,$f8,$80,$f0,$80,$80,$f8,$00,$78,$80,$80,$f0,$80,$80,$78,$00,$20,$20,$20,$20,$20,$20,$a0,$40, -$70,$20,$20,$20,$20,$20,$70,$00,$50,$70,$20,$20,$20,$20,$70,$00,$00,$18,$24,$24,$18,$00,$00,$00,$00,$30, -$78,$78,$30,$00,$00,$00,$00,$00,$00,$00,$30,$00,$00,$00,$3e,$20,$20,$20,$a0,$60,$20,$00,$a0,$50,$50,$50, -$00,$00,$00,$00,$40,$a0,$20,$40,$e0,$00,$00,$00,$00,$38,$38,$38,$38,$38,$38,$00,$3c,$42,$99,$a1,$a1,$99, -$42,$3c,$00,$00,$90,$a8,$e8,$a8,$90,$00,$00,$00,$60,$10,$70,$90,$68,$00,$00,$00,$f0,$80,$f0,$88,$f0,$00, -$00,$00,$90,$90,$90,$f8,$08,$00,$00,$00,$30,$50,$50,$70,$88,$00,$00,$00,$70,$88,$f8,$80,$70,$00,$00,$20, -$70,$a8,$a8,$70,$20,$00,$00,$00,$78,$48,$40,$40,$40,$00,$00,$00,$88,$50,$20,$50,$88,$00,$00,$00,$88,$98, -$a8,$c8,$88,$00,$00,$50,$20,$00,$98,$a8,$c8,$00,$00,$00,$90,$a0,$c0,$a0,$90,$00,$00,$00,$38,$28,$28,$48, -$88,$00,$00,$00,$88,$d8,$a8,$88,$88,$00,$00,$00,$88,$88,$f8,$88,$88,$00,$00,$00,$70,$88,$88,$88,$70,$00, -$00,$00,$78,$48,$48,$48,$48,$00,$00,$00,$78,$88,$78,$28,$48,$00,$00,$00,$f0,$88,$f0,$80,$80,$00,$00,$00, -$78,$80,$80,$80,$78,$00,$00,$00,$f8,$20,$20,$20,$20,$00,$00,$00,$88,$50,$20,$40,$80,$00,$00,$00,$a8,$70, -$20,$70,$a8,$00,$00,$00,$f0,$48,$70,$48,$f0,$00,$00,$00,$40,$40,$70,$48,$70,$00,$00,$00,$88,$88,$c8,$a8, -$c8,$00,$00,$00,$f0,$08,$70,$08,$f0,$00,$00,$00,$a8,$a8,$a8,$a8,$f8,$00,$00,$00,$70,$88,$38,$88,$70,$00, -$00,$00,$a8,$a8,$a8,$f8,$08,$00,$00,$00,$48,$48,$78,$08,$08,$00,$00,$00,$c0,$40,$70,$48,$70,$00,$90,$a8, -$a8,$e8,$a8,$a8,$90,$00,$20,$50,$88,$88,$f8,$88,$88,$00,$f8,$88,$80,$f0,$88,$88,$f0,$00,$90,$90,$90,$90, -$90,$f8,$08,$00,$38,$28,$28,$48,$48,$f8,$88,$00,$f8,$80,$80,$f0,$80,$80,$f8,$00,$20,$70,$a8,$a8,$a8,$70, -$20,$00,$f8,$88,$88,$80,$80,$80,$80,$00,$88,$88,$50,$20,$50,$88,$88,$00,$88,$88,$98,$a8,$c8,$88,$88,$00, -$50,$20,$88,$98,$a8,$c8,$88,$00,$88,$90,$a0,$c0,$a0,$90,$88,$00,$18,$28,$48,$48,$48,$48,$88,$00,$88,$d8, -$a8,$a8,$88,$88,$88,$00,$88,$88,$88,$f8,$88,$88,$88,$00,$70,$88,$88,$88,$88,$88,$70,$00,$f8,$88,$88,$88, -$88,$88,$88,$00,$78,$88,$88,$78,$28,$48,$88,$00,$f0,$88,$88,$f0,$80,$80,$80,$00,$70,$88,$80,$80,$80,$88, -$70,$00,$f8,$20,$20,$20,$20,$20,$20,$00,$88,$88,$88,$50,$20,$40,$80,$00,$a8,$a8,$70,$20,$70,$a8,$a8,$00, -$f0,$48,$48,$70,$48,$48,$f0,$00,$80,$80,$80,$f0,$88,$88,$f0,$00,$88,$88,$88,$c8,$a8,$a8,$c8,$00,$f0,$08, -$08,$30,$08,$08,$f0,$00,$a8,$a8,$a8,$a8,$a8,$a8,$f8,$00,$70,$88,$08,$78,$08,$88,$70,$00,$a8,$a8,$a8,$a8, -$a8,$f8,$08,$00,$88,$88,$88,$88,$78,$08,$08,$00,$c0,$40,$40,$70,$48,$48,$70,$00 -); - -const kgiFont8: array[0..256*8-1] of Byte = ( -$00,$00,$00,$00,$00,$00,$00,$00,$7e,$81,$a5,$81,$bd,$99,$81,$7e,$7e,$ff,$db,$ff,$c3,$e7,$ff,$7e,$6c,$fe, -$fe,$fe,$7c,$38,$10,$00,$10,$38,$7c,$fe,$7c,$38,$10,$00,$38,$7c,$38,$fe,$fe,$d6,$10,$38,$10,$10,$38,$7c, -$fe,$7c,$10,$38,$00,$00,$18,$3c,$3c,$18,$00,$00,$ff,$ff,$e7,$c3,$c3,$e7,$ff,$ff,$00,$3c,$66,$42,$42,$66, -$3c,$00,$ff,$c3,$99,$bd,$bd,$99,$c3,$ff,$0f,$07,$0f,$7d,$cc,$cc,$cc,$78,$3c,$66,$66,$66,$3c,$18,$7e,$18, -$3f,$33,$3f,$30,$30,$70,$f0,$e0,$7f,$63,$7f,$63,$63,$67,$e6,$c0,$99,$5a,$3c,$e7,$e7,$3c,$5a,$99,$80,$e0, -$f8,$fe,$f8,$e0,$80,$00,$02,$0e,$3e,$fe,$3e,$0e,$02,$00,$18,$3c,$7e,$18,$18,$7e,$3c,$18,$66,$66,$66,$66, -$66,$00,$66,$00,$7f,$db,$db,$7b,$1b,$1b,$1b,$00,$7e,$c3,$78,$cc,$cc,$78,$8c,$f8,$00,$00,$00,$00,$7e,$7e, -$7e,$00,$18,$3c,$7e,$18,$7e,$3c,$18,$ff,$18,$3c,$7e,$18,$18,$18,$18,$00,$18,$18,$18,$18,$7e,$3c,$18,$00, -$00,$18,$0c,$fe,$0c,$18,$00,$00,$00,$30,$60,$fe,$60,$30,$00,$00,$00,$00,$c0,$c0,$c0,$fe,$00,$00,$00,$24, -$66,$ff,$66,$24,$00,$00,$00,$18,$3c,$7e,$ff,$ff,$00,$00,$00,$ff,$ff,$7e,$3c,$18,$00,$00,$00,$00,$00,$00, -$00,$00,$00,$00,$30,$78,$78,$30,$30,$00,$30,$00,$6c,$6c,$6c,$00,$00,$00,$00,$00,$6c,$6c,$fe,$6c,$fe,$6c, -$6c,$00,$30,$7c,$c0,$78,$0c,$f8,$30,$00,$00,$c6,$cc,$18,$30,$66,$c6,$00,$38,$6c,$38,$76,$dc,$cc,$76,$00, -$60,$60,$c0,$00,$00,$00,$00,$00,$18,$30,$60,$60,$60,$30,$18,$00,$60,$30,$18,$18,$18,$30,$60,$00,$00,$66, -$3c,$ff,$3c,$66,$00,$00,$00,$30,$30,$fc,$30,$30,$00,$00,$00,$00,$00,$00,$00,$70,$30,$60,$00,$00,$00,$fc, -$00,$00,$00,$00,$00,$00,$00,$00,$00,$30,$30,$00,$06,$0c,$18,$30,$60,$c0,$80,$00,$78,$cc,$dc,$fc,$ec,$cc, -$78,$00,$30,$f0,$30,$30,$30,$30,$fc,$00,$78,$cc,$0c,$38,$60,$cc,$fc,$00,$78,$cc,$0c,$38,$0c,$cc,$78,$00, -$1c,$3c,$6c,$cc,$fe,$0c,$0c,$00,$fc,$c0,$f8,$0c,$0c,$cc,$78,$00,$38,$60,$c0,$f8,$cc,$cc,$78,$00,$fc,$cc, -$0c,$18,$30,$60,$60,$00,$78,$cc,$cc,$78,$cc,$cc,$78,$00,$78,$cc,$cc,$7c,$0c,$18,$70,$00,$00,$00,$30,$30, -$00,$30,$30,$00,$00,$00,$30,$30,$00,$70,$30,$60,$18,$30,$60,$c0,$60,$30,$18,$00,$00,$00,$fc,$00,$fc,$00, -$00,$00,$60,$30,$18,$0c,$18,$30,$60,$00,$78,$cc,$0c,$18,$30,$00,$30,$00,$7c,$c6,$de,$de,$de,$c0,$78,$00, -$30,$78,$cc,$cc,$fc,$cc,$cc,$00,$fc,$66,$66,$7c,$66,$66,$fc,$00,$3c,$66,$c0,$c0,$c0,$66,$3c,$00,$fc,$6c, -$66,$66,$66,$6c,$fc,$00,$fe,$62,$68,$78,$68,$62,$fe,$00,$fe,$62,$68,$78,$68,$60,$f0,$00,$3c,$66,$c0,$c0, -$ce,$66,$3e,$00,$cc,$cc,$cc,$fc,$cc,$cc,$cc,$00,$78,$30,$30,$30,$30,$30,$78,$00,$1e,$0c,$0c,$0c,$cc,$cc, -$78,$00,$e6,$66,$6c,$78,$6c,$66,$e6,$00,$f0,$60,$60,$60,$62,$66,$fe,$00,$c6,$ee,$fe,$d6,$c6,$c6,$c6,$00, -$c6,$e6,$f6,$de,$ce,$c6,$c6,$00,$38,$6c,$c6,$c6,$c6,$6c,$38,$00,$fc,$66,$66,$7c,$60,$60,$f0,$00,$78,$cc, -$cc,$cc,$dc,$78,$1c,$00,$fc,$66,$66,$7c,$78,$6c,$e6,$00,$78,$cc,$e0,$38,$1c,$cc,$78,$00,$fc,$b4,$30,$30, -$30,$30,$78,$00,$cc,$cc,$cc,$cc,$cc,$cc,$fc,$00,$cc,$cc,$cc,$cc,$cc,$78,$30,$00,$c6,$c6,$c6,$d6,$fe,$ee, -$c6,$00,$c6,$c6,$6c,$38,$6c,$c6,$c6,$00,$cc,$cc,$cc,$78,$30,$30,$78,$00,$fe,$cc,$98,$30,$62,$c6,$fe,$00, -$78,$60,$60,$60,$60,$60,$78,$00,$c0,$60,$30,$18,$0c,$06,$02,$00,$78,$18,$18,$18,$18,$18,$78,$00,$10,$38, -$6c,$c6,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$ff,$30,$30,$18,$00,$00,$00,$00,$00,$00,$00,$78,$0c, -$7c,$cc,$76,$00,$e0,$60,$7c,$66,$66,$66,$bc,$00,$00,$00,$78,$cc,$c0,$cc,$78,$00,$1c,$0c,$0c,$7c,$cc,$cc, -$76,$00,$00,$00,$78,$cc,$fc,$c0,$78,$00,$38,$6c,$60,$f0,$60,$60,$f0,$00,$00,$00,$76,$cc,$cc,$7c,$0c,$f8, -$e0,$60,$6c,$76,$66,$66,$e6,$00,$30,$00,$70,$30,$30,$30,$78,$00,$18,$00,$78,$18,$18,$18,$d8,$70,$e0,$60, -$66,$6c,$78,$6c,$e6,$00,$70,$30,$30,$30,$30,$30,$78,$00,$00,$00,$ec,$fe,$d6,$c6,$c6,$00,$00,$00,$f8,$cc, -$cc,$cc,$cc,$00,$00,$00,$78,$cc,$cc,$cc,$78,$00,$00,$00,$dc,$66,$66,$7c,$60,$f0,$00,$00,$76,$cc,$cc,$7c, -$0c,$1e,$00,$00,$d8,$6c,$6c,$60,$f0,$00,$00,$00,$7c,$c0,$78,$0c,$f8,$00,$10,$30,$7c,$30,$30,$34,$18,$00, -$00,$00,$cc,$cc,$cc,$cc,$76,$00,$00,$00,$cc,$cc,$cc,$78,$30,$00,$00,$00,$c6,$c6,$d6,$fe,$6c,$00,$00,$00, -$c6,$6c,$38,$6c,$c6,$00,$00,$00,$cc,$cc,$cc,$7c,$0c,$f8,$00,$00,$fc,$98,$30,$64,$fc,$00,$1c,$30,$30,$e0, -$30,$30,$1c,$00,$18,$18,$18,$00,$18,$18,$18,$00,$e0,$30,$30,$1c,$30,$30,$e0,$00,$76,$dc,$00,$00,$00,$00, -$00,$00,$10,$38,$6c,$c6,$c6,$c6,$fe,$00,$78,$cc,$c0,$cc,$78,$18,$0c,$78,$00,$cc,$00,$cc,$cc,$cc,$7e,$00, -$1c,$00,$78,$cc,$fc,$c0,$78,$00,$7e,$c3,$3c,$06,$3e,$66,$3f,$00,$cc,$00,$78,$0c,$7c,$cc,$7e,$00,$e0,$00, -$78,$0c,$7c,$cc,$7e,$00,$30,$30,$78,$0c,$7c,$cc,$7e,$00,$00,$00,$7c,$c0,$c0,$7c,$06,$3c,$7e,$c3,$3c,$66, -$7e,$60,$3c,$00,$cc,$00,$78,$cc,$fc,$c0,$78,$00,$e0,$00,$78,$cc,$fc,$c0,$78,$00,$cc,$00,$70,$30,$30,$30, -$78,$00,$7c,$c6,$38,$18,$18,$18,$3c,$00,$e0,$00,$70,$30,$30,$30,$78,$00,$cc,$30,$78,$cc,$cc,$fc,$cc,$00, -$30,$30,$00,$78,$cc,$fc,$cc,$00,$1c,$00,$fc,$60,$78,$60,$fc,$00,$00,$00,$7f,$0c,$7f,$cc,$7f,$00,$3e,$6c, -$cc,$fe,$cc,$cc,$ce,$00,$78,$cc,$00,$78,$cc,$cc,$78,$00,$00,$cc,$00,$78,$cc,$cc,$78,$00,$00,$e0,$00,$78, -$cc,$cc,$78,$00,$78,$cc,$00,$cc,$cc,$cc,$7e,$00,$00,$e0,$00,$cc,$cc,$cc,$7e,$00,$00,$cc,$00,$cc,$cc,$fc, -$0c,$f8,$c6,$38,$7c,$c6,$c6,$7c,$38,$00,$cc,$00,$cc,$cc,$cc,$cc,$78,$00,$18,$18,$7e,$c0,$c0,$7e,$18,$18, -$38,$6c,$64,$f0,$60,$e6,$fc,$00,$cc,$cc,$78,$fc,$30,$fc,$30,$00,$f0,$d8,$d8,$f4,$cc,$de,$cc,$0e,$0e,$1b, -$18,$7e,$18,$18,$d8,$70,$1c,$00,$78,$0c,$7c,$cc,$7e,$00,$38,$00,$70,$30,$30,$30,$78,$00,$00,$1c,$00,$78, -$cc,$cc,$78,$00,$00,$1c,$00,$cc,$cc,$cc,$7e,$00,$00,$f8,$00,$f8,$cc,$cc,$cc,$00,$fc,$00,$cc,$ec,$fc,$dc, -$cc,$00,$3c,$6c,$6c,$3e,$00,$7e,$00,$00,$3c,$66,$66,$3c,$00,$7e,$00,$00,$30,$00,$30,$60,$c0,$cc,$78,$00, -$00,$00,$00,$fc,$c0,$c0,$00,$00,$00,$00,$00,$fc,$0c,$0c,$00,$00,$c6,$cc,$d8,$3e,$63,$ce,$98,$1f,$c6,$cc, -$d8,$f3,$67,$cf,$9f,$03,$00,$18,$00,$18,$18,$3c,$3c,$18,$00,$33,$66,$cc,$66,$33,$00,$00,$00,$cc,$66,$33, -$66,$cc,$00,$00,$22,$88,$22,$88,$22,$88,$22,$88,$55,$aa,$55,$aa,$55,$aa,$55,$aa,$dc,$76,$dc,$76,$dc,$76, -$dc,$76,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$f8,$18,$18,$18,$18,$18,$f8,$18,$f8,$18,$18,$18, -$36,$36,$36,$36,$f6,$36,$36,$36,$00,$00,$00,$00,$fe,$36,$36,$36,$00,$00,$f8,$18,$f8,$18,$18,$18,$36,$36, -$f6,$06,$f6,$36,$36,$36,$36,$36,$36,$36,$36,$36,$36,$36,$00,$00,$fe,$06,$f6,$36,$36,$36,$36,$36,$f6,$06, -$fe,$00,$00,$00,$36,$36,$36,$36,$fe,$00,$00,$00,$18,$18,$f8,$18,$f8,$00,$00,$00,$00,$00,$00,$00,$f8,$18, -$18,$18,$18,$18,$18,$18,$1f,$00,$00,$00,$18,$18,$18,$18,$ff,$00,$00,$00,$00,$00,$00,$00,$ff,$18,$18,$18, -$18,$18,$18,$18,$1f,$18,$18,$18,$00,$00,$00,$00,$ff,$00,$00,$00,$18,$18,$18,$18,$ff,$18,$18,$18,$18,$18, -$1f,$18,$1f,$18,$18,$18,$36,$36,$36,$36,$37,$36,$36,$36,$36,$36,$37,$30,$3f,$00,$00,$00,$00,$00,$3f,$30, -$37,$36,$36,$36,$36,$36,$f7,$00,$ff,$00,$00,$00,$00,$00,$ff,$00,$f7,$36,$36,$36,$36,$36,$37,$30,$37,$36, -$36,$36,$00,$00,$ff,$00,$ff,$00,$00,$00,$36,$36,$f7,$00,$f7,$36,$36,$36,$18,$18,$ff,$00,$ff,$00,$00,$00, -$36,$36,$36,$36,$ff,$00,$00,$00,$00,$00,$ff,$00,$ff,$18,$18,$18,$00,$00,$00,$00,$ff,$36,$36,$36,$36,$36, -$36,$36,$3f,$00,$00,$00,$18,$18,$1f,$18,$1f,$00,$00,$00,$00,$00,$1f,$18,$1f,$18,$18,$18,$00,$00,$00,$00, -$3f,$36,$36,$36,$36,$36,$36,$36,$f7,$36,$36,$36,$18,$18,$ff,$00,$ff,$18,$18,$18,$18,$18,$18,$18,$f8,$00, -$00,$00,$00,$00,$00,$00,$1f,$18,$18,$18,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$ff,$ff,$ff,$ff, -$f0,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$00,$00, -$76,$dc,$c8,$dc,$76,$00,$00,$78,$cc,$f8,$cc,$f8,$c0,$c0,$00,$fe,$c6,$c0,$c0,$c0,$c0,$00,$00,$fe,$6c,$6c, -$6c,$6c,$6c,$00,$fe,$66,$30,$18,$30,$66,$fe,$00,$00,$00,$7e,$cc,$cc,$cc,$78,$00,$00,$66,$66,$66,$66,$7c, -$60,$c0,$00,$76,$dc,$18,$18,$18,$18,$00,$fc,$30,$78,$cc,$cc,$78,$30,$fc,$38,$6c,$c6,$fe,$c6,$6c,$38,$00, -$38,$6c,$c6,$c6,$6c,$6c,$ee,$00,$1c,$30,$18,$7c,$cc,$cc,$78,$00,$00,$00,$7e,$db,$db,$7e,$00,$00,$06,$0c, -$7e,$db,$db,$7e,$60,$c0,$3c,$60,$c0,$fc,$c0,$60,$3c,$00,$78,$cc,$cc,$cc,$cc,$cc,$cc,$00,$00,$fc,$00,$fc, -$00,$fc,$00,$00,$30,$30,$fc,$30,$30,$00,$fc,$00,$60,$30,$18,$30,$60,$00,$fc,$00,$18,$30,$60,$30,$18,$00, -$fc,$00,$0e,$1b,$1b,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$d8,$d8,$70,$30,$30,$00,$fc,$00,$30,$30,$00, -$00,$72,$9c,$00,$72,$9c,$00,$00,$38,$6c,$6c,$38,$00,$00,$00,$00,$00,$00,$00,$18,$18,$00,$00,$00,$00,$00, -$00,$00,$18,$00,$00,$00,$0f,$0c,$0c,$0c,$ec,$6c,$3c,$1c,$78,$6c,$6c,$6c,$6c,$00,$00,$00,$78,$0c,$38,$60, -$7c,$00,$00,$00,$00,$00,$3c,$3c,$3c,$3c,$00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff -); - -const kgiFont6PropWidth: array[0..256-1] of Byte = ( - $08,$08,$08,$07,$07,$07,$07,$04,$08,$07,$08,$08,$06,$06,$06,$07, - $06,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08, - $85,$21,$13,$05,$05,$05,$05,$13,$13,$13,$05,$05,$12,$14,$12,$05, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$21,$12,$05,$05,$05,$05, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$05,$05,$05,$05,$05, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$13,$05,$05, - $13,$05,$05,$05,$05,$05,$05,$05,$05,$13,$04,$14,$13,$05,$05,$05, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$14,$21,$04,$05,$08, - $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$04, - $44,$08,$08,$08,$08,$08,$08,$08,$05,$04,$05,$08,$08,$08,$08,$08, - $05,$05,$05,$05,$05,$05,$13,$13,$05,$05,$05,$04,$05,$05,$05,$05, - $05,$05,$05,$05,$05,$03,$04,$04,$06,$05,$04,$07,$04,$03,$05,$08, - $05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$04,$05,$05,$05,$05, - $14,$05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$05,$05,$14,$05, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05 -); - -const kgiFont8PropWidth: array[0..256-1] of Byte = ( - $08,$08,$08,$07,$07,$07,$07,$06,$08,$07,$08,$08,$07,$08,$08,$08, - $07,$07,$07,$07,$08,$08,$07,$08,$07,$07,$07,$07,$07,$08,$08,$08, - $85,$14,$15,$07,$06,$07,$07,$03,$14,$14,$08,$06,$13,$06,$22,$07, - $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$22,$13,$05,$06,$15,$06, - $07,$06,$07,$07,$07,$07,$07,$07,$06,$14,$07,$07,$07,$07,$07,$07, - $07,$06,$07,$06,$06,$06,$06,$07,$07,$06,$07,$14,$07,$14,$07,$08, - $23,$07,$07,$06,$07,$06,$06,$07,$07,$14,$05,$07,$14,$07,$06,$06, - $07,$07,$06,$06,$15,$07,$06,$07,$07,$06,$06,$06,$32,$06,$07,$07, - $06,$07,$06,$08,$07,$07,$07,$07,$08,$06,$06,$06,$07,$05,$06,$06, - $06,$08,$07,$06,$06,$06,$07,$07,$06,$07,$06,$07,$07,$06,$07,$08, - $07,$05,$06,$07,$06,$06,$16,$16,$06,$06,$06,$08,$08,$06,$08,$08, - $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08, - $38,$08,$08,$38,$08,$08,$38,$28,$28,$28,$08,$08,$28,$08,$08,$08, - $08,$08,$08,$28,$38,$38,$28,$08,$08,$08,$38,$08,$08,$08,$48,$08, - $07,$06,$07,$07,$07,$07,$07,$07,$06,$07,$07,$06,$08,$08,$06,$06, - $06,$06,$06,$06,$35,$05,$06,$07,$15,$32,$32,$08,$15,$15,$24,$08 -); - - -function createFontTexture (constref font: array of Byte; constref fontwdt: array of Byte; prop: Boolean): GLuint; -const - Width = 16*8; - Height = 16*8; -var - tex, tpp: PByte; - b: Byte; - cc: Integer; - x, y, dx, dy: Integer; -begin - GetMem(tex, Width*Height*4); - - for cc := 0 to 255 do - begin - x := (cc mod 16)*8; - y := (cc div 16)*8; - for dy := 0 to 7 do - begin - b := font[cc*8+dy]; - if prop then b := b shl (fontwdt[cc] shr 4); - tpp := tex+((y+dy)*(Width*4))+x*4; - for dx := 0 to 7 do - begin - if ((b and $80) <> 0) then - begin - tpp^ := 255; Inc(tpp); - tpp^ := 255; Inc(tpp); - tpp^ := 255; Inc(tpp); - tpp^ := 255; Inc(tpp); - end - else - begin - tpp^ := 0; Inc(tpp); - tpp^ := 0; Inc(tpp); - tpp^ := 0; Inc(tpp); - tpp^ := 0; Inc(tpp); - end; - b := (b and $7f) shl 1; - end; - end; - end; - - glGenTextures(1, @result); - if (result = 0) then raise Exception.Create('can''t create Holmes font texture'); - - glBindTexture(GL_TEXTURE_2D, result); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); - - //GLfloat[4] bclr = 0.0; - //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr); - - glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex); - glFlush(); - - //FreeMem(tex); -end; - - -var - font6texid: GLuint = 0; - font8texid: GLuint = 0; - prfont6texid: GLuint = 0; - prfont8texid: GLuint = 0; - -procedure createFonts (); -begin - if (font6texid = 0) then font6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, false); - if (font8texid = 0) then font8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, false); - if (prfont6texid = 0) then prfont6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, true); - if (prfont8texid = 0) then prfont8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, true); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -procedure normRGBA (var r, g, b, a: Integer); inline; -begin - if (a < 0) then a := 0 else if (a > 255) then a := 255; - if (r < 0) then r := 0 else if (r > 255) then r := 255; - if (g < 0) then g := 0 else if (g > 255) then g := 255; - if (b < 0) then b := 0 else if (b > 255) then b := 255; -end; - -// returns `false` if the color is transparent -function setupGLColor (r, g, b, a: Integer): Boolean; -begin - normRGBA(r, g, b, a); - if (a < 255) then - begin - if (a = 0) then begin result := false; exit; end; - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - end - else - begin - glDisable(GL_BLEND); - end; - glColor4ub(Byte(r), Byte(g), Byte(b), Byte(a)); - result := true; -end; - -function isScaled (): Boolean; -var - mt: packed array [0..15] of Double; -begin - glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]); - result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -function textWidth6 (const s: AnsiString): Integer; -var - f: Integer; -begin - result := 0; - for f := 1 to Length(s) do Inc(result, Integer(kgiFont6PropWidth[Integer(s[f])] and $0f)+1); - if (result > 0) then Dec(result); // don't count last empty pixel -end; - - -function textWidth8 (const s: AnsiString): Integer; -var - f: Integer; -begin - result := 0; - for f := 1 to Length(s) do Inc(result, Integer(kgiFont8PropWidth[Integer(s[f])] and $0f)+1); - if (result > 0) then Dec(result); // don't count last empty pixel -end; - - -// return width (including last empty pixel) -function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer; -var - f, c: Integer; - tx, ty: Integer; -begin - result := 0; - if (Length(s) = 0) then exit; - if not setupGLColor(r, g, b, a) then exit; - glEnable(GL_ALPHA_TEST); - glAlphaFunc(GL_NOTEQUAL, 0.0); - glEnable(GL_TEXTURE_2D); - // color and opacity - glBindTexture(GL_TEXTURE_2D, tid); - - for f := 1 to Length(s) do - begin - c := Integer(s[f]) and $ff; - tx := (c mod 16)*8; - ty := (c div 16)*8; - glBegin(GL_QUADS); - glTexCoord2f((tx+0)/128.0, (ty+0)/128.0); glVertex2i(x+0, y+0); // top-left - glTexCoord2f((tx+8)/128.0, (ty+0)/128.0); glVertex2i(x+8, y+0); // top-right - glTexCoord2f((tx+8)/128.0, (ty+8)/128.0); glVertex2i(x+8, y+8); // bottom-right - glTexCoord2f((tx+0)/128.0, (ty+8)/128.0); glVertex2i(x+0, y+8); // bottom-left - glEnd(); - if prop then - begin - x += Integer(fontwdt[c] and $0f)+1; - result += Integer(fontwdt[c] and $0f)+1; - end - else - begin - x += wdt; - result += wdt; - end; - end; - - glDisable(GL_ALPHA_TEST); - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - glColor4f(1, 1, 1, 1); - glBindTexture(GL_TEXTURE_2D, 0); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255); -begin - if (len < 1) then exit; - if not setupGLColor(r, g, b, a) then exit; - glDisable(GL_TEXTURE_2D); - if (not isScaled) then - begin - glBegin(GL_LINES); - glVertex2f(x+0.375, y+0.375); - glVertex2f(x+len+0.375, y+0.375); - glEnd(); - end - else - begin - glBegin(GL_QUADS); - glVertex2i(x, y); - glVertex2i(x+len, y); - glVertex2i(x+len, y+1); - glVertex2i(x, y+1); - glEnd(); - end; -end; - - -procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255); -begin - if (len < 1) then exit; - if not setupGLColor(r, g, b, a) then exit; - glDisable(GL_TEXTURE_2D); - if (not isScaled) then - begin - glBegin(GL_LINES); - glVertex2f(x+0.375, y+0.375); - glVertex2f(x+0.375, y+len+0.375); - glEnd(); - end - else - begin - glBegin(GL_QUADS); - glVertex2i(x, y); - glVertex2i(x, y+len); - glVertex2i(x+1, y+len); - glVertex2i(x+1, y); - glEnd(); - end; -end; - - -procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255); -begin - if not setupGLColor(r, g, b, a) then exit; - - glDisable(GL_TEXTURE_2D); - - glLineWidth(1); - glPointSize(1); - - glBegin(GL_LINES); - glVertex2f(x1+0.37, y1+0.37); - glVertex2f(x2+0.37, y2+0.37); - glEnd(); - - if (x1 <> x2) or (y1 <> y2) then - begin - glBegin(GL_POINTS); - glVertex2f(x2+0.37, y2+0.37); - glEnd(); - end; - - glColor4f(1, 1, 1, 1); - glDisable(GL_BLEND); -end; - - -procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); -begin - if (w < 0) or (h < 0) then exit; - if not setupGLColor(r, g, b, a) then exit; - glDisable(GL_TEXTURE_2D); - glLineWidth(1); - glDisable(GL_LINE_SMOOTH); - glDisable(GL_POLYGON_SMOOTH); - if (w = 1) and (h = 1) then - begin - glBegin(GL_POINTS); - glVertex2f(x+0.37, y+0.37); - glEnd(); - end - else - begin - glBegin(GL_LINES); - glVertex2i(x, y); glVertex2i(x+w, y); // top - glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom - glVertex2f(x+0.37, y+1); glVertex2f(x+0.37, y+h-1); // left - glVertex2f(x+w-1+0.37, y+1); glVertex2f(x+w-1+0.37, y+h-1); // right - glEnd(); - end; - //glRect(x, y, x+w, y+h); - glColor4f(1, 1, 1, 1); - glDisable(GL_BLEND); -end; - - -procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); - procedure hline (x, y, len: Integer); - begin - if (len < 1) then exit; - glBegin(GL_QUADS); - glVertex2i(x, y); - glVertex2i(x+len, y); - glVertex2i(x+len, y+1); - glVertex2i(x, y+1); - glEnd(); - end; - - procedure vline (x, y, len: Integer); - begin - if (len < 1) then exit; - glBegin(GL_QUADS); - glVertex2i(x, y); - glVertex2i(x, y+len); - glVertex2i(x+1, y+len); - glVertex2i(x+1, y); - glEnd(); - end; - -var - scaled: Boolean; -begin - if (w < 0) or (h < 0) then exit; - if not setupGLColor(r, g, b, a) then exit; - glDisable(GL_TEXTURE_2D); - glLineWidth(1); - glDisable(GL_LINE_SMOOTH); - glDisable(GL_POLYGON_SMOOTH); - scaled := isScaled(); - if (w = 1) and (h = 1) then - begin - glBegin(GL_POINTS); - if scaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375); - glEnd(); - end - else - begin - if not scaled then - begin - glBegin(GL_LINES); - glVertex2i(x, y); glVertex2i(x+w, y); // top - glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom - glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left - glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right - glEnd(); - end - else - begin - hline(x, y, w); - hline(x, y+h-1, w); - vline(x, y+1, h-2); - vline(x+w-1, y+1, h-2); - end; - end; - //glRect(x, y, x+w, y+h); - glColor4f(1, 1, 1, 1); - glDisable(GL_BLEND); -end; - - -procedure darkenRect (x, y, w, h: Integer; a: Integer); -begin - if (w < 0) or (h < 0) then exit; - if (a < 0) then a := 0; - if (a >= 255) then exit; - glEnable(GL_BLEND); - glBlendFunc(GL_ZERO, GL_SRC_ALPHA); - glDisable(GL_LINE_SMOOTH); - glDisable(GL_POLYGON_SMOOTH); - glDisable(GL_TEXTURE_2D); - glColor4ub(0, 0, 0, Byte(a)); - glBegin(GL_QUADS); - glVertex2i(x, y); - glVertex2i(x+w, y); - glVertex2i(x+w, y+h); - glVertex2i(x, y+h); - glEnd(); - //glRect(x, y, x+w, y+h); - glColor4f(1, 1, 1, 1); - glDisable(GL_BLEND); - //glBlendEquation(GL_FUNC_ADD); -end; - - -procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); -begin - if (w < 0) or (h < 0) then exit; - if not setupGLColor(r, g, b, a) then exit; - glDisable(GL_LINE_SMOOTH); - glDisable(GL_POLYGON_SMOOTH); - glDisable(GL_TEXTURE_2D); - glBegin(GL_QUADS); - glVertex2f(x, y); - glVertex2f(x+w, y); - glVertex2f(x+w, y+h); - glVertex2f(x, y+h); - glEnd(); - glColor4f(1, 1, 1, 1); - glDisable(GL_BLEND); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (font6texid = 0) then createFonts(); - drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false); - result := Length(s)*6; -end; - -function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (font8texid = 0) then createFonts(); - drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false); - result := Length(s)*8; -end; - -function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (prfont6texid = 0) then createFonts(); - result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true); -end; - -function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (prfont8texid = 0) then createFonts(); - result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -// x-centered at `x` -function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (font6texid = 0) then createFonts(); - x -= Length(s)*6 div 2; - drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false); - result := Length(s)*6; -end; - -function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (font8texid = 0) then createFonts(); - x -= Length(s)*8 div 2; - drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false); - result := Length(s)*8; -end; - -function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (prfont6texid = 0) then createFonts(); - x -= textWidth6(s) div 2; - result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true); -end; - -function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; -begin - if (prfont8texid = 0) then createFonts(); - x -= textWidth8(s) div 2; - result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true); -end; - - // ////////////////////////////////////////////////////////////////////////// // function monsTypeToString (mt: Byte): AnsiString; begin @@ -898,3 +75,122 @@ begin end; result := 'unknown'; end; + + +// ////////////////////////////////////////////////////////////////////////// // +function typeKind2Str (t: TTypeKind): AnsiString; +begin + case t of + tkUnknown: result := 'Unknown'; + tkInteger: result := 'Integer'; + tkChar: result := 'Char'; + tkEnumeration: result := 'Enumeration'; + tkFloat: result := 'Float'; + tkSet: result := 'Set'; + tkMethod: result := 'Method'; + tkSString: result := 'SString'; + tkLString: result := 'LString'; + tkAString: result := 'AString'; + tkWString: result := 'WString'; + tkVariant: result := 'Variant'; + tkArray: result := 'Array'; + tkRecord: result := 'Record'; + tkInterface: result := 'Interface'; + tkClass: result := 'Class'; + tkObject: result := 'Object'; + tkWChar: result := 'WChar'; + tkBool: result := 'Bool'; + tkInt64: result := 'Int64'; + tkQWord: result := 'QWord'; + tkDynArray: result := 'DynArray'; + tkInterfaceRaw: result := 'InterfaceRaw'; + tkProcVar: result := 'ProcVar'; + tkUString: result := 'UString'; + tkUChar: result := 'UChar'; + tkHelper: result := 'Helper'; + tkFile: result := 'File'; + tkClassRef: result := 'ClassRef'; + tkPointer: result := 'Pointer'; + else result := ''; + end; +end; + + +procedure dumpPublishedProperties (obj: TObject); +var + pt: PTypeData; + pi: PTypeInfo; + i, j: Integer; + pp: PPropList; +begin + if (obj = nil) then exit; + e_LogWritefln('Object of type ''%s'':', [obj.ClassName]); + pi := obj.ClassInfo; + pt := GetTypeData(pi); + e_LogWritefln('property count: %s', [pt.PropCount]); + GetMem(pp, pt^.PropCount*sizeof(Pointer)); + try + j := GetPropList(pi, [tkInteger, tkBool, tkSString, tkLString, tkAString, tkSet, tkEnumeration], pp); + //e_LogWritefln('ordinal property count: %s', [j]); + for i := 0 to j-1 do + begin + if (typinfo.PropType(obj, pp^[i].name) in [tkSString, tkLString, tkAString]) then + begin + e_LogWritefln(' #%s: <%s>; type: %s; value: <%s>', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetStrProp(obj, pp^[i])]); + end + else if (typinfo.PropType(obj, pp^[i].name) = tkSet) then + begin + e_LogWritefln(' #%s: <%s>; type: %s; value: %s', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetSetProp(obj, pp^[i], true)]); + end + else if (typinfo.PropType(obj, pp^[i].name) = tkEnumeration) then + begin + e_LogWritefln(' #%s: <%s>; type: %s; value: <%s>', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetEnumProp(obj, pp^[i])]); + end + else + begin + e_LogWritefln(' #%s: <%s>; type: %s; value: %s', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetOrdProp(obj, pp^[i])]); + end; + end; + finally + FreeMem(pp); + end; +end; + + +//FIXME: autogenerate +function trigType2Str (ttype: Integer): AnsiString; +begin + result := ''; + case ttype of + TRIGGER_NONE: result := 'none'; + TRIGGER_EXIT: result := 'exit'; + TRIGGER_TELEPORT: result := 'teleport'; + TRIGGER_OPENDOOR: result := 'opendoor'; + TRIGGER_CLOSEDOOR: result := 'closedoor'; + TRIGGER_DOOR: result := 'door'; + TRIGGER_DOOR5: result := 'door5'; + TRIGGER_CLOSETRAP: result := 'closetrap'; + TRIGGER_TRAP: result := 'trap'; + TRIGGER_PRESS: result := 'press'; + TRIGGER_SECRET: result := 'secret'; + TRIGGER_LIFTUP: result := 'liftup'; + TRIGGER_LIFTDOWN: result := 'liftdown'; + TRIGGER_LIFT: result := 'lift'; + TRIGGER_TEXTURE: result := 'texture'; + TRIGGER_ON: result := 'on'; + TRIGGER_OFF: result := 'off'; + TRIGGER_ONOFF: result := 'onoff'; + TRIGGER_SOUND: result := 'sound'; + TRIGGER_SPAWNMONSTER: result := 'spawnmonster'; + TRIGGER_SPAWNITEM: result := 'spawnitem'; + TRIGGER_MUSIC: result := 'music'; + TRIGGER_PUSH: result := 'push'; + TRIGGER_SCORE: result := 'score'; + TRIGGER_MESSAGE: result := 'message'; + TRIGGER_DAMAGE: result := 'damage'; + TRIGGER_HEALTH: result := 'health'; + TRIGGER_SHOT: result := 'shot'; + TRIGGER_EFFECT: result := 'effect'; + TRIGGER_SCRIPT: result := 'script'; + end; +end; diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas index 33db7d0..3b630ab 100644 --- a/src/game/g_holmes.pas +++ b/src/game/g_holmes.pas @@ -23,59 +23,9 @@ uses e_log, e_input, g_textures, g_basic, e_graphics, g_phys, g_grid, g_player, g_monsters, g_window, g_map, g_triggers, g_items, g_game, g_panel, g_console, g_gfx, - xprofiler; - - -type - THMouseEvent = record - public - const - // both for but and for bstate - Left = $0001; - Right = $0002; - Middle = $0004; - WheelUp = $0008; - WheelDown = $0010; - - // event types - Release = 0; - Press = 1; - Motion = 2; - - public - kind: Byte; // motion, press, release - x, y: Integer; - dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion - but: Word; // current pressed/released button, or 0 for motion - bstate: Word; // button state - kstate: Word; // keyboard state (see THKeyEvent); - end; - - THKeyEvent = record - public - const - // modifiers - ModCtrl = $0001; - ModAlt = $0002; - ModShift = $0004; - - // event types - Release = 0; - Press = 1; - - public - kind: Byte; - scan: Word; // SDL_SCANCODE_XXX - sym: Word; // SDLK_XXX - bstate: Word; // button state - kstate: Word; // keyboard state - - public - end; + xprofiler, + sdlcarcass, glgfx, gh_ui; -procedure g_Holmes_VidModeChanged (); -procedure g_Holmes_WindowFocused (); -procedure g_Holmes_WindowBlured (); procedure g_Holmes_Draw (); procedure g_Holmes_DrawUI (); @@ -89,16 +39,8 @@ procedure g_Holmes_plrViewSize (viewPortW, viewPortH: Integer); procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer); -operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; -operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; - -operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; -operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; - - var g_holmes_enabled: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF}; - g_holmes_ui_scale: Single = 1.0; implementation @@ -129,248 +71,9 @@ var // ////////////////////////////////////////////////////////////////////////// // {$INCLUDE g_holmes.inc} -{$INCLUDE g_holmes_ui.inc} {$INCLUDE g_holmes_ol.inc} // outliner -// ////////////////////////////////////////////////////////////////////////// // -// any mods = 255: nothing was defined -function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; -var - pos, epos: Integer; -begin - kmods := 255; - mbuts := 255; - pos := 1; - //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos); - if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos); - while (pos < Length(s)) do - begin - if (Length(s)-pos >= 2) and (s[pos+1] = '-') then - begin - case s[pos] of - 'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModCtrl; Inc(pos, 2); continue; end; - 'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModAlt; Inc(pos, 2); continue; end; - 'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModShift; Inc(pos, 2); continue; end; - end; - break; - end; - if (Length(s)-pos >= 4) and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+1] = 'b')) and (s[pos+3] = '-') then - begin - case s[pos] of - 'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Left; Inc(pos, 4); continue; end; - 'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Right; Inc(pos, 4); continue; end; - 'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Middle; Inc(pos, 4); continue; end; - end; - break; - end; - break; - end; - epos := Length(s)+1; - while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos); - if (epos > pos) then result := Copy(s, pos, epos-pos) else result := ''; -end; - - -operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; -var - f: Integer; - kmods: Byte = 255; - mbuts: Byte = 255; - kname: AnsiString; -begin - result := false; - if (Length(s) > 0) then - begin - if (s[1] = '+') then begin if (ev.kind <> ev.Press) then exit; end - else if (s[1] = '-') then begin if (ev.kind <> ev.Release) then exit; end - else if (s[1] = '*') then begin end - else if (ev.kind <> ev.Press) then exit; - end; - kname := parseModKeys(s, kmods, mbuts); - if (kmods = 255) then kmods := 0; - if (ev.kstate <> kmods) then exit; - if (mbuts <> 255) and (ev.bstate <> mbuts) then exit; - for f := 1 to High(e_KeyNames) do - begin - if (CompareText(kname, e_KeyNames[f]) = 0) then - begin - result := (ev.scan = f); - exit; - end; - end; -end; - - -operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; -begin - result := (ev = s); -end; - - -operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; -var - kmods: Byte = 255; - mbuts: Byte = 255; - kname: AnsiString; - but: Integer = -1; -begin - result := false; - - if (Length(s) > 0) then - begin - if (s[1] = '+') then begin if (ev.kind <> ev.Press) then exit; end - else if (s[1] = '-') then begin if (ev.kind <> ev.Release) then exit; end - else if (s[1] = '*') then begin if (ev.kind <> ev.Motion) then exit; end - else if (ev.kind <> ev.Press) then exit; - end; - - kname := parseModKeys(s, kmods, mbuts); - if (CompareText(kname, 'LMB') = 0) then but := THMouseEvent.Left - else if (CompareText(kname, 'RMB') = 0) then but := THMouseEvent.Right - else if (CompareText(kname, 'MMB') = 0) then but := THMouseEvent.Middle - else if (CompareText(kname, 'None') = 0) then but := 0 - else exit; - - //conwritefln('s=[%s]; kname=[%s]; kmods=%s; mbuts=%s; but=%s', [s, kname, kmods, mbuts, but]); - - if (mbuts = 255) then mbuts := 0; - if (kmods = 255) then kmods := 0; - if (ev.kstate <> kmods) then exit; - - if (ev.kind = ev.Press) then mbuts := mbuts or but - else if (ev.kind = ev.Release) then mbuts := mbuts and (not but); - - //conwritefln(' ev.bstate=%s; ev.but=%s; mbuts=%s', [ev.bstate, ev.but, mbuts]); - - result := (ev.bstate = mbuts) and (ev.but = but); -end; - - -operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; -begin - result := (ev = s); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -function typeKind2Str (t: TTypeKind): AnsiString; -begin - case t of - tkUnknown: result := 'Unknown'; - tkInteger: result := 'Integer'; - tkChar: result := 'Char'; - tkEnumeration: result := 'Enumeration'; - tkFloat: result := 'Float'; - tkSet: result := 'Set'; - tkMethod: result := 'Method'; - tkSString: result := 'SString'; - tkLString: result := 'LString'; - tkAString: result := 'AString'; - tkWString: result := 'WString'; - tkVariant: result := 'Variant'; - tkArray: result := 'Array'; - tkRecord: result := 'Record'; - tkInterface: result := 'Interface'; - tkClass: result := 'Class'; - tkObject: result := 'Object'; - tkWChar: result := 'WChar'; - tkBool: result := 'Bool'; - tkInt64: result := 'Int64'; - tkQWord: result := 'QWord'; - tkDynArray: result := 'DynArray'; - tkInterfaceRaw: result := 'InterfaceRaw'; - tkProcVar: result := 'ProcVar'; - tkUString: result := 'UString'; - tkUChar: result := 'UChar'; - tkHelper: result := 'Helper'; - tkFile: result := 'File'; - tkClassRef: result := 'ClassRef'; - tkPointer: result := 'Pointer'; - else result := ''; - end; -end; - - -procedure dumpPublishedProperties (obj: TObject); -var - pt: PTypeData; - pi: PTypeInfo; - i, j: Integer; - pp: PPropList; -begin - if (obj = nil) then exit; - e_LogWritefln('Object of type ''%s'':', [obj.ClassName]); - pi := obj.ClassInfo; - pt := GetTypeData(pi); - e_LogWritefln('property count: %s', [pt.PropCount]); - GetMem(pp, pt^.PropCount*sizeof(Pointer)); - try - j := GetPropList(pi, [tkInteger, tkBool, tkSString, tkLString, tkAString, tkSet, tkEnumeration], pp); - //e_LogWritefln('ordinal property count: %s', [j]); - for i := 0 to j-1 do - begin - if (typinfo.PropType(obj, pp^[i].name) in [tkSString, tkLString, tkAString]) then - begin - e_LogWritefln(' #%s: <%s>; type: %s; value: <%s>', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetStrProp(obj, pp^[i])]); - end - else if (typinfo.PropType(obj, pp^[i].name) = tkSet) then - begin - e_LogWritefln(' #%s: <%s>; type: %s; value: %s', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetSetProp(obj, pp^[i], true)]); - end - else if (typinfo.PropType(obj, pp^[i].name) = tkEnumeration) then - begin - e_LogWritefln(' #%s: <%s>; type: %s; value: <%s>', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetEnumProp(obj, pp^[i])]); - end - else - begin - e_LogWritefln(' #%s: <%s>; type: %s; value: %s', [i+1, pp^[i].name, typeKind2Str(typinfo.PropType(obj, pp^[i].name)), GetOrdProp(obj, pp^[i])]); - end; - end; - finally - FreeMem(pp); - end; -end; - - -//FIXME: autogenerate -function trigType2Str (ttype: Integer): AnsiString; -begin - result := ''; - case ttype of - TRIGGER_NONE: result := 'none'; - TRIGGER_EXIT: result := 'exit'; - TRIGGER_TELEPORT: result := 'teleport'; - TRIGGER_OPENDOOR: result := 'opendoor'; - TRIGGER_CLOSEDOOR: result := 'closedoor'; - TRIGGER_DOOR: result := 'door'; - TRIGGER_DOOR5: result := 'door5'; - TRIGGER_CLOSETRAP: result := 'closetrap'; - TRIGGER_TRAP: result := 'trap'; - TRIGGER_PRESS: result := 'press'; - TRIGGER_SECRET: result := 'secret'; - TRIGGER_LIFTUP: result := 'liftup'; - TRIGGER_LIFTDOWN: result := 'liftdown'; - TRIGGER_LIFT: result := 'lift'; - TRIGGER_TEXTURE: result := 'texture'; - TRIGGER_ON: result := 'on'; - TRIGGER_OFF: result := 'off'; - TRIGGER_ONOFF: result := 'onoff'; - TRIGGER_SOUND: result := 'sound'; - TRIGGER_SPAWNMONSTER: result := 'spawnmonster'; - TRIGGER_SPAWNITEM: result := 'spawnitem'; - TRIGGER_MUSIC: result := 'music'; - TRIGGER_PUSH: result := 'push'; - TRIGGER_SCORE: result := 'score'; - TRIGGER_MESSAGE: result := 'message'; - TRIGGER_DAMAGE: result := 'damage'; - TRIGGER_HEALTH: result := 'health'; - TRIGGER_SHOT: result := 'shot'; - TRIGGER_EFFECT: result := 'effect'; - TRIGGER_SCRIPT: result := 'script'; - end; -end; - // ////////////////////////////////////////////////////////////////////////// // {$INCLUDE g_holmes_cmd.inc} procedure holmesInitCommands (); forward; @@ -601,50 +304,30 @@ end; procedure toggleLayersWindow (arg: Integer=-1); begin - showLayersWindow := not showLayersWindow; + if (arg < 0) then showLayersWindow := not showLayersWindow else showLayersWindow := (arg > 0); toggleLayersWindowCB(nil, 0); end; procedure toggleOutlineWindow (arg: Integer=-1); begin - showOutlineWindow := not showOutlineWindow; + if (arg < 0) then showOutlineWindow := not showOutlineWindow else showOutlineWindow := (arg > 0); toggleOutlineWindowCB(nil, 0); end; procedure toggleHelpWindow (arg: Integer=-1); begin if (winHelp = nil) then createHelpWindow(); - if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp); + if (arg < 0) then begin if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp); end + else if (arg = 0) then begin if uiVisibleWindow(winHelp) then uiRemoveWindow(winHelp); end + else begin if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp); end end; procedure toggleOptionsWindow (arg: Integer=-1); begin if (winOptions = nil) then createOptionsWindow(); - if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -procedure g_Holmes_VidModeChanged (); -begin - e_WriteLog(Format('Holmes: videomode changed: %dx%d', [gScreenWidth, gScreenHeight]), TMsgType.Notify); - // texture space is possibly lost here, idc - curtexid := 0; - font6texid := 0; - font8texid := 0; - prfont6texid := 0; - prfont8texid := 0; - //createCursorTexture(); -end; - -procedure g_Holmes_WindowFocused (); -begin - msB := 0; - kbS := 0; -end; - -procedure g_Holmes_WindowBlured (); -begin + if (arg < 0) then begin if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions); end + else if (arg = 0) then begin if uiVisibleWindow(winOptions) then uiRemoveWindow(winOptions); end + else begin if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions); end end; @@ -1427,17 +1110,19 @@ var he: THMouseEvent; begin if g_Game_IsNet then begin result := false; exit; end; + if not g_holmes_enabled then begin result := false; exit; end; + holmesInitCommands(); holmesInitBinds(); result := true; - msX := trunc(ev.x/g_holmes_ui_scale); - msY := trunc(ev.y/g_holmes_ui_scale); + msX := ev.x; + msY := ev.y; msB := ev.bstate; kbS := ev.kstate; msB := msB; he := ev; - he.x := trunc(he.x/g_holmes_ui_scale); - he.y := trunc(he.y/g_holmes_ui_scale); + he.x := he.x; + he.y := he.y; if not uiMouseEvent(he) then plrDebugMouse(he); end; @@ -1457,6 +1142,8 @@ var begin if g_Game_IsNet then begin result := false; exit; end; + if not g_holmes_enabled then begin result := false; exit; end; + holmesInitCommands(); holmesInitBinds(); result := false; @@ -1471,7 +1158,7 @@ begin if uiKeyEvent(ev) then begin result := true; exit; end; if keybindExecute(ev) then begin result := true; exit; end; // press - if (ev.kind = THKeyEvent.Press) then + if (ev.press) then begin {$IF DEFINED(D2F_DEBUG)} // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction @@ -1508,6 +1195,7 @@ end; procedure g_Holmes_Draw (); begin if g_Game_IsNet then exit; + {$IF not DEFINED(HEADLESS)} holmesInitCommands(); holmesInitBinds(); @@ -1528,12 +1216,19 @@ end; procedure g_Holmes_DrawUI (); begin if g_Game_IsNet then exit; + if not g_holmes_enabled then exit; {$IF not DEFINED(HEADLESS)} - glPushMatrix(); - glScalef(g_holmes_ui_scale, g_holmes_ui_scale, 1.0); + gGfxDoClear := false; + //if assigned(prerenderFrameCB) then prerenderFrameCB(); uiDraw(); - drawCursor(); - glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + try + //glLoadIdentity(); + if assigned(postrenderFrameCB) then postrenderFrameCB(); + finally + glPopMatrix(); + end; {$ENDIF} end; @@ -1800,6 +1495,21 @@ begin end; +function onMouseEvent (var ev: THMouseEvent): Boolean; +begin + result := g_Holmes_MouseEvent(ev); +end; + +function onKeyEvent (var ev: THKeyEvent): Boolean; +begin + if not g_holmes_enabled then begin result := false; exit; end; + result := g_Holmes_keyEvent(ev); +end; + + begin - conRegVar('hlm_ui_scale', @g_holmes_ui_scale, 0.01, 5.0, 'Holmes UI scale', '', false); + evMouseCB := onMouseEvent; + evKeyCB := onKeyEvent; + + conRegVar('hlm_ui_scale', @gh_ui_scale, 0.01, 5.0, 'Holmes UI scale', '', false); end. diff --git a/src/game/g_window.pas b/src/game/g_window.pas index 62e5574..8a23d00 100644 --- a/src/game/g_window.pas +++ b/src/game/g_window.pas @@ -53,7 +53,8 @@ uses SDL2, GL, GLExt, e_graphics, e_log, e_texture, g_main, g_console, e_input, g_options, g_game, g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net, - g_map, g_gfx, g_monsters, g_holmes, xprofiler; + g_map, g_gfx, g_monsters, g_holmes, xprofiler, + sdlcarcass, gh_ui; const @@ -75,12 +76,19 @@ var ticksOverflow: Int64 = -1; lastTicks: Uint32 = 0; // to detect overflow {$ENDIF} -{$IF not DEFINED(HEADLESS)} - curMsButState: Word = 0; - curKbState: Word = 0; - curMsX: Integer = 0; - curMsY: Integer = 0; -{$ENDIF} + + +procedure KillGLWindow (); +begin + if (h_Wnd <> nil) then + begin + if assigned(oglDeinitCB) then oglDeinitCB(); + end; + if (h_Wnd <> nil) then SDL_DestroyWindow(h_Wnd); + if (h_GL <> nil) then SDL_GL_DeleteContext(h_GL); + h_Wnd := nil; + h_GL := nil; +end; function g_Window_SetDisplay (preserveGL: Boolean = false): Boolean; @@ -99,11 +107,7 @@ begin if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN; if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED; - if (h_Wnd <> nil) then - begin - SDL_DestroyWindow(h_Wnd); - h_Wnd := nil; - end; + KillGLWindow(); if gFullscreen then begin @@ -129,13 +133,17 @@ begin SDL_GL_MakeCurrent(h_Wnd, h_GL); SDL_ShowCursor(SDL_DISABLE); + if (h_GL <> nil) then + begin + if assigned(oglInitCB) then oglInitCB(); + end; {$ENDIF} result := true; end; -function GetDisplayModes(dbpp: LongWord; var selres: LongWord): SSArray; +function GetDisplayModes (dbpp: LongWord; var selres: LongWord): SSArray; var mode: TSDL_DisplayMode; res, i, k, n, pw, ph: Integer; @@ -178,7 +186,6 @@ begin g_Game_SetupScreenSize(); g_Menu_Reset(); g_Game_ClearLoading(); - g_Holmes_VidModeChanged(); {$ENDIF} end; @@ -216,15 +223,6 @@ begin end; -procedure resetKMState (); -begin -{$IF not DEFINED(HEADLESS)} - curMsButState := 0; - curKbState := 0; -{$ENDIF} -end; - - function WindowEventHandler (constref ev: TSDL_WindowEvent): Boolean; var wActivate, wDeactivate: Boolean; @@ -245,7 +243,6 @@ begin SDL_WINDOWEVENT_MINIMIZED: begin - resetKMState(); e_UnpressAllKeys(); if not wMinimized then begin @@ -262,7 +259,6 @@ begin SDL_WINDOWEVENT_RESIZED: begin - resetKMState(); gScreenWidth := ev.data1; gScreenHeight := ev.data2; ChangeWindowSize(); @@ -279,7 +275,6 @@ begin SDL_WINDOWEVENT_MAXIMIZED: begin - resetKMState(); if wMinimized then begin e_ResizeWindow(gScreenWidth, gScreenHeight); @@ -299,15 +294,13 @@ begin SDL_WINDOWEVENT_RESTORED: begin - resetKMState(); if wMinimized then begin e_ResizeWindow(gScreenWidth, gScreenHeight); wMinimized := false; wActivate := true; end; - if gWinMaximized then - gWinMaximized := false; + if gWinMaximized then gWinMaximized := false; if g_debug_WinMsgs then begin g_Console_Add('Now restored'); @@ -317,19 +310,15 @@ begin SDL_WINDOWEVENT_FOCUS_GAINED: begin - resetKMState(); wActivate := true; //e_WriteLog('window gained focus!', MSG_NOTIFY); - g_Holmes_WindowFocused(); end; SDL_WINDOWEVENT_FOCUS_LOST: begin - resetKMState(); wDeactivate := true; e_UnpressAllKeys(); //e_WriteLog('window lost focus!', MSG_NOTIFY); - g_Holmes_WindowBlured(); end; end; @@ -354,6 +343,8 @@ begin end; gWinActive := false; + + if assigned(winBlurCB) then winBlurCB(); end; end else if wActivate then @@ -376,6 +367,7 @@ begin end; gWinActive := true; + if assigned(winFocusCB) then winFocusCB(); end; end; end; @@ -385,39 +377,9 @@ function EventHandler (var ev: TSDL_Event): Boolean; var key, keychr: Word; uc: UnicodeChar; - {$IF not DEFINED(HEADLESS)} - msev: THMouseEvent; - kbev: THKeyEvent; - {$ENDIF} - - function buildBut (b: Byte): Word; - begin - result := 0; - case b of - SDL_BUTTON_LEFT: result := result or THMouseEvent.Left; - SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle; - SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right; - end; - end; - - {$IF not DEFINED(HEADLESS)} - procedure updateKBState (); - var - kbstate: PUint8; - begin - curKbState := 0; - kbstate := SDL_GetKeyboardState(nil); - if (kbstate[SDL_SCANCODE_LCTRL] <> 0) or (kbstate[SDL_SCANCODE_RCTRL] <> 0) then curKbState := curKbState or THKeyEvent.ModCtrl; - if (kbstate[SDL_SCANCODE_LALT] <> 0) or (kbstate[SDL_SCANCODE_RALT] <> 0) then curKbState := curKbState or THKeyEvent.ModAlt; - if (kbstate[SDL_SCANCODE_LSHIFT] <> 0) or (kbstate[SDL_SCANCODE_RSHIFT] <> 0) then curKbState := curKbState or THKeyEvent.ModShift; - end; - {$ENDIF} - + down: Boolean; begin result := false; - {$IF not DEFINED(HEADLESS)} - updateKBState(); - {$ENDIF} case ev.type_ of SDL_WINDOWEVENT: @@ -425,7 +387,7 @@ begin SDL_QUITEV: begin - if gExit <> EXIT_QUIT then + if (gExit <> EXIT_QUIT) then begin if not wLoadingProgress then begin @@ -433,7 +395,9 @@ begin g_Game_Quit(); end else + begin wLoadingQuit := true; + end; end; result := true; end; @@ -441,74 +405,22 @@ begin SDL_KEYDOWN, SDL_KEYUP: begin key := ev.key.keysym.scancode; + down := (ev.type_ = SDL_KEYDOWN); {$IF not DEFINED(HEADLESS)} - if (g_holmes_enabled) then + if evSDLCB(ev) then begin - if (ev.type_ = SDL_KEYDOWN) then kbev.kind := THKeyEvent.Press else kbev.kind := THKeyEvent.Release; - kbev.scan := ev.key.keysym.scancode; - kbev.sym := ev.key.keysym.sym; - kbev.bstate := curMsButState; - kbev.kstate := curKbState; - if g_Holmes_keyEvent(kbev) then - begin - if (ev.type_ <> SDL_KEYDOWN) then e_KeyUpDown(ev.key.keysym.scancode, false); - exit; - end; + // event eaten, but... + if not down then e_KeyUpDown(key, false); + exit; end; {$ENDIF} - if (ev.type_ = SDL_KEYDOWN) then KeyPress(key); - e_KeyUpDown(ev.key.keysym.scancode, (ev.type_ = SDL_KEYDOWN)); + if down then KeyPress(key); + e_KeyUpDown(key, down); end; {$IF not DEFINED(HEADLESS)} - SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: - begin - msev.dx := ev.button.x-curMsX; - msev.dy := ev.button.y-curMsY; - curMsX := ev.button.x; - curMsY := ev.button.y; - if (ev.type_ = SDL_MOUSEBUTTONDOWN) then msev.kind := THMouseEvent.Press else msev.kind := THMouseEvent.Release; - msev.but := buildBut(ev.button.button); - msev.x := curMsX; - msev.y := curMsY; - if (msev.but <> 0) then - begin - // ev.button.clicks: Byte - if (ev.type_ = SDL_MOUSEBUTTONDOWN) then curMsButState := curMsButState or msev.but else curMsButState := curMsButState and (not msev.but); - msev.bstate := curMsButState; - msev.kstate := curKbState; - if (g_holmes_enabled) then g_Holmes_mouseEvent(msev); - end; - end; - SDL_MOUSEWHEEL: - begin - if (ev.wheel.y <> 0) then - begin - msev.dx := 0; - msev.dy := ev.wheel.y; - msev.kind := THMouseEvent.Press; - if (ev.wheel.y < 0) then msev.but := THMouseEvent.WheelUp else msev.but := THMouseEvent.WheelDown; - msev.x := curMsX; - msev.y := curMsY; - msev.bstate := curMsButState; - msev.kstate := curKbState; - if (g_holmes_enabled) then g_Holmes_mouseEvent(msev); - end; - end; - SDL_MOUSEMOTION: - begin - msev.dx := ev.button.x-curMsX; - msev.dy := ev.button.y-curMsY; - curMsX := ev.button.x; - curMsY := ev.button.y; - msev.kind := THMouseEvent.Motion; - msev.but := 0; - msev.x := curMsX; - msev.y := curMsY; - msev.bstate := curMsButState; - msev.kstate := curKbState; - if (g_holmes_enabled) then g_Holmes_mouseEvent(msev); - end; + SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP, SDL_MOUSEWHEEL, SDL_MOUSEMOTION: + evSDLCB(ev); {$ENDIF} SDL_TEXTINPUT: @@ -532,15 +444,6 @@ begin end; -procedure KillGLWindow(); -begin - if (h_Wnd <> nil) then SDL_DestroyWindow(h_Wnd); - if (h_GL <> nil) then SDL_GL_DeleteContext(h_GL); - h_Wnd := nil; - h_GL := nil; -end; - - function CreateGLWindow (Title: PChar): Boolean; begin result := false; @@ -563,6 +466,7 @@ begin {$IF not DEFINED(HEADLESS)} h_Gl := SDL_GL_CreateContext(h_Wnd); if (h_Gl = nil) then exit; + if assigned(oglInitCB) then oglInitCB(); {$ENDIF} e_ResizeWindow(gScreenWidth, gScreenHeight); @@ -887,7 +791,7 @@ begin begin if (idx <= ParamCount) then begin - if not conParseFloat(g_holmes_ui_scale, ParamStr(idx)) then g_holmes_ui_scale := 1.0; + if not conParseFloat(gh_ui_scale, ParamStr(idx)) then gh_ui_scale := 1.0; Inc(idx); end; end; diff --git a/src/game/g_holmes_ui.inc b/src/gx/gh_ui.pas similarity index 84% rename from src/game/g_holmes_ui.inc rename to src/gx/gh_ui.pas index 2b915e6..aa94e62 100644 --- a/src/game/g_holmes_ui.inc +++ b/src/gx/gh_ui.pas @@ -13,9 +13,20 @@ * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) +{$INCLUDE ../shared/a_modes.inc} +unit gh_ui; + +interface + +uses + SysUtils, Classes, + GL, GLExt, SDL2, + sdlcarcass, glgfx; + + // ////////////////////////////////////////////////////////////////////////// // type - THControl = class(TPoolObject) + THControl = class public type TActionCB = procedure (me: THControl; uinfo: Integer); @@ -34,8 +45,8 @@ type mDrawShadow: Boolean; private + scis: TScissorSave; scallowed: Boolean; - scxywh: array[0..3] of GLint; protected function getEnabled (): Boolean; @@ -64,11 +75,6 @@ type // DO NOT USE! procedure setScissorGLInternal (x, y, w, h: Integer); - public - // return `false` if destination rect is empty - // modifies rect0 - class function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; - public actionCB: TActionCB; @@ -195,19 +201,39 @@ type end; +function uiMouseEvent (ev: THMouseEvent): Boolean; +function uiKeyEvent (ev: THKeyEvent): Boolean; +procedure uiDraw (); + +procedure uiAddWindow (ctl: THControl); +procedure uiRemoveWindow (ctl: THControl); +function uiVisibleWindow (ctl: THControl): Boolean; + + +var + gh_ui_scale: Single = 1.0; + + +implementation + + // ////////////////////////////////////////////////////////////////////////// // var uiTopList: array of THControl = nil; -function uiMouseEvent (var ev: THMouseEvent): Boolean; +function uiMouseEvent (ev: THMouseEvent): Boolean; var f, c: Integer; lx, ly: Integer; ctmp: THControl; begin + ev.x := trunc(ev.x/gh_ui_scale); + ev.y := trunc(ev.y/gh_ui_scale); + ev.dx := trunc(ev.dx/gh_ui_scale); //FIXME + ev.dy := trunc(ev.dy/gh_ui_scale); //FIXME if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev); - if not result and (ev.kind = ev.Press) then + if not result and (ev.press) then begin for f := High(uiTopList) downto 0 do begin @@ -233,10 +259,12 @@ begin end; -function uiKeyEvent (var ev: THKeyEvent): Boolean; +function uiKeyEvent (ev: THKeyEvent): Boolean; begin + ev.x := trunc(ev.x/gh_ui_scale); + ev.y := trunc(ev.y/gh_ui_scale); if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev); - if (ev.kind = ev.Release) then begin result := true; exit; end; + if (ev.release) then begin result := true; exit; end; end; @@ -245,11 +273,20 @@ var f: Integer; ctl: THControl; begin - for f := 0 to High(uiTopList) do - begin - ctl := uiTopList[f]; - ctl.draw(); - if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + try + glLoadIdentity(); + glScalef(gh_ui_scale, gh_ui_scale, 1); + for f := 0 to High(uiTopList) do + begin + ctl := uiTopList[f]; + ctl.draw(); + if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128); + end; + finally + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); end; end; @@ -638,38 +675,15 @@ begin end; -//TODO: overflow checks -class function THControl.intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; -var - ex0, ey0: Integer; -begin - result := false; - if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; - // check for intersection - if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit; - if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit; - // ok, intersects - ex0 := x0+w0; - ey0 := y0+h0; - if (x0 < x1) then x0 := x1; - if (y0 < y1) then y0 := y1; - if (ex0 > x1+w1) then ex0 := x1+w1; - if (ey0 > y1+h1) then ey0 := y1+h1; - w0 := ex0-x0; - h0 := ey0-y0; - result := (w0 > 0) and (h0 > 0); -end; - - procedure THControl.setScissorGLInternal (x, y, w, h: Integer); begin if not scallowed then exit; - x := trunc(x*g_holmes_ui_scale); - y := trunc(y*g_holmes_ui_scale); - w := trunc(w*g_holmes_ui_scale); - h := trunc(h*g_holmes_ui_scale); - y := gWinSizeY-(y+h); - if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h); + x := trunc(x*gh_ui_scale); + y := trunc(y*gh_ui_scale); + w := trunc(w*gh_ui_scale); + h := trunc(h*gh_ui_scale); + //y := gWinSizeY-(y+h); + scis.setRect(x, y, w, h); end; @@ -702,7 +716,6 @@ procedure THControl.draw (); var f: Integer; x, y: Integer; - wassc: Boolean; begin if (mWidth < 1) or (mHeight < 1) then exit; x := 0; @@ -710,27 +723,20 @@ begin toGlobal(x, y); //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]); - scxywh[0] := 0; - scxywh[1] := 0; - scxywh[2] := 0; - scxywh[3] := 0; - - wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0); - if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]); - //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]); - glEnable(GL_SCISSOR_TEST); - scallowed := true; - - resetScissor(); - drawControl(x, y); - if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2); - for f := 0 to High(mChildren) do mChildren[f].draw(); - if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor(); - drawControlPost(x, y); - glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]); - - if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST); - scallowed := false; + scis.save(true); // scissoring enabled + try + //glEnable(GL_SCISSOR_TEST); + scallowed := true; + resetScissor(); + drawControl(x, y); + if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2); + for f := 0 to High(mChildren) do mChildren[f].draw(); + if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor(); + drawControlPost(x, y); + finally + scis.restore(); + scallowed := false; + end; end; @@ -762,7 +768,7 @@ begin if (mGrab <> nil) then begin result := mGrab.mouseEvent(ev); - if (ev.kind = ev.Release) then mGrab := nil; + if (ev.release) then mGrab := nil; exit; end; end; @@ -789,35 +795,29 @@ begin if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev); if (mParent = nil) then begin - if (ev.kind = ev.Press) and (ev = 'S-Tab') then + if (ev = 'S-Tab') then begin result := true; - if (ev.kind = ev.Press) then + ctl := findPrevFocus(mFocused); + if (ctl <> mFocused) then begin - ctl := findPrevFocus(mFocused); - if (ctl <> mFocused) then - begin - mGrab := nil; - mFocused := ctl; - end; + mGrab := nil; + mFocused := ctl; end; exit; end; - if (ev.kind = ev.Press) and (ev = 'Tab') then + if (ev = 'Tab') then begin result := true; - if (ev.kind = ev.Press) then + ctl := findNextFocus(mFocused); + if (ctl <> mFocused) then begin - ctl := findNextFocus(mFocused); - if (ctl <> mFocused) then - begin - mGrab := nil; - mFocused := ctl; - end; + mGrab := nil; + mFocused := ctl; end; exit; end; - if mEscClose and (ev.kind = ev.Press) and (ev = 'Escape') then + if mEscClose and (ev = 'Escape') then begin result := true; uiRemoveWindow(self); @@ -853,8 +853,8 @@ procedure THTopWindow.centerInScreen (); begin if (mWidth > 0) and (mHeight > 0) then begin - mX := trunc((gWinSizeX/g_holmes_ui_scale-mWidth)/2); - mY := trunc((gWinSizeY/g_holmes_ui_scale-mHeight)/2); + mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2); + mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2); end; end; @@ -910,7 +910,7 @@ function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean; begin result := inherited keyEvent(ev); if not getFocused then exit; - if (ev.kind = ev.Press) and (ev = 'M-F3') then + if (ev = 'M-F3') then begin uiRemoveWindow(self); result := true; @@ -933,7 +933,7 @@ begin mY += ev.y-mDragStartY; mDragStartX := ev.x; mDragStartY := ev.y; - if (ev.kind = ev.Release) then mDragging := false; + if (ev.release) then mDragging := false; result := true; exit; end; @@ -942,7 +942,7 @@ begin ly := ev.y; if toLocal(lx, ly) then begin - if (ev.kind = ev.Press) then + if (ev.press) then begin if (ly < 8) then begin @@ -971,7 +971,7 @@ begin end; end; - if (ev.kind = ev.Release) then + if (ev.release) then begin if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then begin @@ -983,7 +983,7 @@ begin mInClose := false; end; - if (ev.kind = ev.Motion) then + if (ev.motion) then begin if mWaitingClose then begin @@ -996,7 +996,7 @@ begin else begin mInClose := false; - if (ev.kind <> ev.Motion) then mWaitingClose := false; + if (not ev.motion) then mWaitingClose := false; end; result := inherited mouseEvent(ev); @@ -1160,7 +1160,7 @@ begin if not result and toLocal(lx, ly) then begin result := true; - if (ev.kind = ev.Press) and (ev = 'lmb') then + if (ev = 'lmb') then begin ly := ly div 8; if (ly >= 0) and (ly < Length(mItems)) then @@ -1186,62 +1186,62 @@ begin result := inherited keyEvent(ev); if not getFocused then exit; //result := true; - if (ev.kind = ev.Press) then + if (ev = 'Home') or (ev = 'PageUp') then begin - if (ev = 'Home') or (ev = 'PageUp') then - begin - result := true; - mCurIndex := 0; - end; - if (ev = 'End') or (ev = 'PageDown') then - begin - result := true; - mCurIndex := High(mItems); - end; - if (ev = 'Up') then + result := true; + mCurIndex := 0; + end; + if (ev = 'End') or (ev = 'PageDown') then + begin + result := true; + mCurIndex := High(mItems); + end; + if (ev = 'Up') then + begin + result := true; + if (Length(mItems) > 0) then begin - result := true; - if (Length(mItems) > 0) then - begin - if (mCurIndex < 0) then mCurIndex := Length(mItems); - while (mCurIndex > 0) do - begin - Dec(mCurIndex); - if (mItems[mCurIndex].varp <> nil) then break; - end; - end - else + if (mCurIndex < 0) then mCurIndex := Length(mItems); + while (mCurIndex > 0) do begin - mCurIndex := -1; + Dec(mCurIndex); + if (mItems[mCurIndex].varp <> nil) then break; end; + end + else + begin + mCurIndex := -1; end; - if (ev = 'Down') then + end; + if (ev = 'Down') then + begin + result := true; + if (Length(mItems) > 0) then begin - result := true; - if (Length(mItems) > 0) then + if (mCurIndex < 0) then mCurIndex := -1; + while (mCurIndex < High(mItems)) do begin - if (mCurIndex < 0) then mCurIndex := -1; - while (mCurIndex < High(mItems)) do - begin - Inc(mCurIndex); - if (mItems[mCurIndex].varp <> nil) then break; - end; - end - else - begin - mCurIndex := -1; + Inc(mCurIndex); + if (mItems[mCurIndex].varp <> nil) then break; end; + end + else + begin + mCurIndex := -1; end; - if (ev = 'Space') or (ev = 'Return') then + end; + if (ev = 'Space') or (ev = 'Enter') then + begin + result := true; + if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then begin - result := true; - if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then - begin - it := @mItems[mCurIndex]; - it.varp^ := not it.varp^; - if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^)); - if assigned(actionCB) then actionCB(self, mCurIndex); - end; + it := @mItems[mCurIndex]; + it.varp^ := not it.varp^; + if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^)); + if assigned(actionCB) then actionCB(self, mCurIndex); end; end; end; + + +end. diff --git a/src/gx/glgfx.pas b/src/gx/glgfx.pas new file mode 100644 index 0000000..fb7e593 --- /dev/null +++ b/src/gx/glgfx.pas @@ -0,0 +1,1504 @@ +(* Copyright (C) DooM 2D:Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} +unit glgfx; + +interface + +uses + SysUtils, Classes, + GL, GLExt, SDL2, + sdlcarcass; + + +// ////////////////////////////////////////////////////////////////////////// // +type + THMouseEvent = record + public + const + // both for but and for bstate + None = 0; + Left = $0001; + Right = $0002; + Middle = $0004; + WheelUp = $0008; + WheelDown = $0010; + + // event types + type + TKind = (Release, Press, Motion); + + public + kind: TKind; // motion, press, release + x, y: Integer; // current mouse position + dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion + but: Word; // current pressed/released button, or 0 for motion + bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet) + kstate: Word; // keyboard state (see THKeyEvent); + + public + function press (): Boolean; inline; + function release (): Boolean; inline; + function motion (): Boolean; inline; + end; + + THKeyEvent = record + public + const + // modifiers + ModCtrl = $0001; + ModAlt = $0002; + ModShift = $0004; + ModHyper = $0008; + + // event types + type + TKind = (Release, Press); + + public + kind: TKind; + scan: Word; // SDL_SCANCODE_XXX + sym: LongWord; // SDLK_XXX + x, y: Integer; // current mouse position + bstate: Word; // button state + kstate: Word; // keyboard state BEFORE event (i.e. press/release modifications aren't done yet) + + public + function press (): Boolean; inline; + function release (): Boolean; inline; + end; + + +// ////////////////////////////////////////////////////////////////////////// // +// setup 2D OpenGL mode; will be called automatically in `glInit()` +procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false); + +type + TScissorSave = record + public + wassc: Boolean; + scxywh: packed array[0..3] of GLint; + + public + + public + procedure save (enableScissoring: Boolean); + procedure restore (); + + // set new scissor rect, bounded by the saved scissor rect + procedure setRect (x, y, w, h: Integer); + end; + + +procedure oglDrawCursor (); +procedure oglDrawCursorAt (msX, msY: Integer); + +// return `false` if destination rect is empty +// modifies rect0 +function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; + +procedure normRGBA (var r, g, b, a: Integer); inline; +function setupGLColor (r, g, b, a: Integer): Boolean; +function isScaled (): Boolean; + +function textWidth6 (const s: AnsiString): Integer; +function textWidth8 (const s: AnsiString): Integer; +// return width (including last empty pixel) +function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer; +procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255); +procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255); +procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255); +procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); +procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); +procedure darkenRect (x, y, w, h: Integer; a: Integer); +procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); +function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +// x-centered at `x` +function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; + + +// ////////////////////////////////////////////////////////////////////////// // +// event handlers +var + evMouseCB: function (var ev: THMouseEvent): Boolean = nil; // `true`: event eaten + evKeyCB: function (var ev: THKeyEvent): Boolean = nil; // `true`: event eaten + + +// ////////////////////////////////////////////////////////////////////////// // +function getMouseX (): Integer; inline; +function getMouseY (): Integer; inline; +function getButState (): Word; inline; +function getModState (): Word; inline; + + +// ////////////////////////////////////////////////////////////////////////// // +property + gMouseX: Integer read getMouseX; + gMouseY: Integer read getMouseY; + gButState: Word read getButState; + gModState: Word read getModState; + +var + gGfxDoClear: Boolean = true; + + +// ////////////////////////////////////////////////////////////////////////// // +// any mods = 255: nothing was defined +function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; + +operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; +operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; + +operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; +operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; + + +implementation + + +var + curButState: Word = 0; + curModState: Word = 0; + curMsX: Integer = 0; + curMsY: Integer = 0; + + +// ////////////////////////////////////////////////////////////////////////// // +function strEquCI (const s0, s1: AnsiString): Boolean; +var + f: Integer; + c0, c1: AnsiChar; +begin + result := (Length(s0) = Length(s1)); + if result then + begin + for f := 1 to Length(s0) do + begin + c0 := s0[f]; + if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()` + c1 := s1[f]; + if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()` + if (c0 <> c1) then begin result := false; exit; end; + end; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function getMouseX (): Integer; inline; begin result := curMsX; end; +function getMouseY (): Integer; inline; begin result := curMsY; end; +function getButState (): Word; inline; begin result := curButState; end; +function getModState (): Word; inline; begin result := curModState; end; + + +// ////////////////////////////////////////////////////////////////////////// // +function THMouseEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end; +function THMouseEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end; +function THMouseEvent.motion (): Boolean; inline; begin result := (kind = TKind.Motion); end; + +function THKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end; +function THKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end; + + +// ////////////////////////////////////////////////////////////////////////// // +// any mods = 255: nothing was defined +function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; +var + pos, epos: Integer; +begin + kmods := 255; + mbuts := 255; + pos := 1; + //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos); + if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos); + while (pos < Length(s)) do + begin + if (Length(s)-pos >= 2) and (s[pos+1] = '-') then + begin + case s[pos] of + 'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModCtrl; Inc(pos, 2); continue; end; + 'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModAlt; Inc(pos, 2); continue; end; + 'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModShift; Inc(pos, 2); continue; end; + end; + break; + end; + if (Length(s)-pos >= 4) and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+1] = 'b')) and (s[pos+3] = '-') then + begin + case s[pos] of + 'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Left; Inc(pos, 4); continue; end; + 'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Right; Inc(pos, 4); continue; end; + 'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Middle; Inc(pos, 4); continue; end; + end; + break; + end; + break; + end; + epos := Length(s)+1; + while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos); + if (epos > pos) then result := Copy(s, pos, epos-pos) else result := ''; +end; + + +operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; +var + f: Integer; + kmods: Byte = 255; + mbuts: Byte = 255; + kname: AnsiString; +begin + result := false; + if (Length(s) > 0) then + begin + if (s[1] = '+') then begin if (not ev.press) then exit; end + else if (s[1] = '-') then begin if (not ev.release) then exit; end + else if (s[1] = '*') then begin end + else if (not ev.press) then exit; + end; + kname := parseModKeys(s, kmods, mbuts); + if (kmods = 255) then kmods := 0; + if (ev.kstate <> kmods) then exit; + if (mbuts <> 255) and (ev.bstate <> mbuts) then exit; + + if (strEquCI(kname, 'Enter')) then kname := 'RETURN'; + + for f := 0 to SDL_NUM_SCANCODES-1 do + begin + if strEquCI(kname, SDL_GetScancodeName(f)) then + begin + result := (ev.scan = f); + exit; + end; + end; +end; + + +operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; +begin + result := (ev = s); +end; + + +operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; +var + kmods: Byte = 255; + mbuts: Byte = 255; + kname: AnsiString; + but: Integer = -1; +begin + result := false; + + if (Length(s) > 0) then + begin + if (s[1] = '+') then begin if (not ev.press) then exit; end + else if (s[1] = '-') then begin if (not ev.release) then exit; end + else if (s[1] = '*') then begin if (not ev.motion) then exit; end + else if (not ev.press) then exit; + end; + + kname := parseModKeys(s, kmods, mbuts); + if strEquCI(kname, 'LMB') then but := THMouseEvent.Left + else if strEquCI(kname, 'RMB') then but := THMouseEvent.Right + else if strEquCI(kname, 'MMB') then but := THMouseEvent.Middle + else if strEquCI(kname, 'WheelUp') or strEquCI(kname, 'WUP') then but := THMouseEvent.WheelUp + else if strEquCI(kname, 'WheelDown') or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := THMouseEvent.WheelDown + else if strEquCI(kname, 'None') then but := 0 + else exit; + + if (mbuts = 255) then mbuts := 0; + if (kmods = 255) then kmods := 0; + if (ev.kstate <> kmods) then exit; + + result := (ev.bstate = mbuts) and (ev.but = but); +end; + + +operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; +begin + result := (ev = s); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure resetKMState (sendEvents: Boolean=true); +var + mask: Word; + mev: THMouseEvent; + kev: THKeyEvent; +begin + // generate mouse release events + if (curButState <> 0) then + begin + if sendEvents then + begin + mask := 1; + while (mask <> 0) do + begin + // checked each time, 'cause `evMouseCB` can be changed from the handler + if ((curButState and mask) <> 0) and assigned(evMouseCB) then + begin + mev.kind := mev.TKind.Release; + mev.x := curMsX; + mev.y := curMsY; + mev.dx := 0; + mev.dy := 0; + mev.but := mask; + mev.bstate := curButState; + mev.kstate := curModState; + curButState := curButState and (not mask); + evMouseCB(mev); + end; + mask := mask shl 1; + end; + end; + curButState := 0; + end; + + // generate modifier release events + if (curModState <> 0) then + begin + if sendEvents then + begin + mask := 1; + while (mask <= 8) do + begin + // checked each time, 'cause `evMouseCB` can be changed from the handler + if ((curModState and mask) <> 0) and assigned(evKeyCB) then + begin + kev.kind := kev.TKind.Release; + case mask of + THKeyEvent.ModCtrl: begin kev.scan := SDL_SCANCODE_LCTRL; kev.sym := SDLK_LCTRL;{arbitrary} end; + THKeyEvent.ModAlt: begin kev.scan := SDL_SCANCODE_LALT; kev.sym := SDLK_LALT;{arbitrary} end; + THKeyEvent.ModShift: begin kev.scan := SDL_SCANCODE_LSHIFT; kev.sym := SDLK_LSHIFT;{arbitrary} end; + THKeyEvent.ModHyper: begin kev.scan := SDL_SCANCODE_LGUI; kev.sym := SDLK_LGUI;{arbitrary} end; + else assert(false); + end; + kev.x := curMsX; + kev.y := curMsY; + mev.bstate := 0{curMsButState}; // anyway + mev.kstate := curModState; + curModState := curModState and (not mask); + evKeyCB(kev); + end; + mask := mask shl 1; + end; + end; + curModState := 0; + end; +end; + + +function onSDLEvent (var ev: TSDL_Event): Boolean; +var + mev: THMouseEvent; + kev: THKeyEvent; + + function buildBut (b: Byte): Word; + begin + result := 0; + case b of + SDL_BUTTON_LEFT: result := result or THMouseEvent.Left; + SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle; + SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right; + end; + end; + +begin + result := false; + + case ev.type_ of + SDL_KEYDOWN, SDL_KEYUP: + begin + // fix left/right modifiers + if (ev.type_ = SDL_KEYDOWN) then kev.kind := THKeyEvent.TKind.Press else kev.kind := THKeyEvent.TKind.Release; + kev.scan := ev.key.keysym.scancode; + kev.sym := ev.key.keysym.sym; + + if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL; + if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT; + if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT; + if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI; + + if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL; + if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT; + if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT; + if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI; + + kev.x := curMsX; + kev.y := curMsY; + kev.bstate := curButState; + kev.kstate := curModState; + + case kev.scan of + SDL_SCANCODE_LCTRL: if (kev.press) then curModState := curModState or THKeyEvent.ModCtrl else curModState := curModState and (not THKeyEvent.ModCtrl); + SDL_SCANCODE_LALT: if (kev.press) then curModState := curModState or THKeyEvent.ModAlt else curModState := curModState and (not THKeyEvent.ModAlt); + SDL_SCANCODE_LSHIFT: if (kev.press) then curModState := curModState or THKeyEvent.ModShift else curModState := curModState and (not THKeyEvent.ModShift); + end; + + if assigned(evKeyCB) then result := evKeyCB(kev); + end; + + SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: + begin + mev.dx := ev.button.x-curMsX; + mev.dy := ev.button.y-curMsY; + curMsX := ev.button.x; + curMsY := ev.button.y; + if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release; + mev.but := buildBut(ev.button.button); + mev.x := curMsX; + mev.y := curMsY; + mev.bstate := curButState; + mev.kstate := curModState; + if (mev.but <> 0) then + begin + // ev.button.clicks: Byte + if (ev.type_ = SDL_MOUSEBUTTONDOWN) then curButState := curButState or mev.but else curButState := curButState and (not mev.but); + if assigned(evMouseCB) then result := evMouseCB(mev); + end; + end; + SDL_MOUSEWHEEL: + begin + if (ev.wheel.y <> 0) then + begin + mev.dx := 0; + mev.dy := ev.wheel.y; + mev.kind := THMouseEvent.TKind.Press; + if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown; + mev.x := curMsX; + mev.y := curMsY; + mev.bstate := curButState; + mev.kstate := curModState; + if assigned(evMouseCB) then result := evMouseCB(mev); + end; + end; + SDL_MOUSEMOTION: + begin + mev.dx := ev.button.x-curMsX; + mev.dy := ev.button.y-curMsY; + curMsX := ev.button.x; + curMsY := ev.button.y; + mev.kind := THMouseEvent.TKind.Motion; + mev.but := 0; + mev.x := curMsX; + mev.y := curMsY; + mev.bstate := curButState; + mev.kstate := curModState; + if assigned(evMouseCB) then result := evMouseCB(mev); + end; + + { + SDL_TEXTINPUT: + begin + Utf8ToUnicode(@uc, PChar(ev.text.text), 1); + keychr := Word(uc); + if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr))); + CharPress(AnsiChar(keychr)); + end; + } + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false); +begin + glViewport(0, 0, winWidth, winHeight); + + glDisable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glDisable(GL_LINE_SMOOTH); + glDisable(GL_POINT_SMOOTH); + glDisable(GL_DEPTH_TEST); + glDisable(GL_TEXTURE_2D); + glDisable(GL_LIGHTING); + glDisable(GL_DITHER); + glDisable(GL_STENCIL_TEST); + glDisable(GL_SCISSOR_TEST); + glDisable(GL_CULL_FACE); + + glMatrixMode(GL_PROJECTION); + glLoadIdentity(); + if (upsideDown) then + begin + glOrtho(0, winWidth, 0, winHeight, -1, 1); // set origin to bottom left + end + else + begin + glOrtho(0, winWidth, winHeight, 0, -1, 1); // set origin to top left + end; + + glMatrixMode(GL_MODELVIEW); + glLoadIdentity(); + + glClearColor(0, 0, 0, 0); + glColor4f(1, 1, 1, 1); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// cursor (hi, Death Track!) +const curTexWidth = 32; +const curTexHeight = 32; +const curWidth = 17; +const curHeight = 23; + +const cursorImg: array[0..curWidth*curHeight-1] of Byte = ( + 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 3,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 3,3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0, + 3,3,4,2,2,0,0,0,0,0,0,0,0,0,0,0,0, + 3,3,4,4,2,2,0,0,0,0,0,0,0,0,0,0,0, + 3,3,4,4,4,2,2,0,0,0,0,0,0,0,0,0,0, + 3,3,4,4,4,4,2,2,0,0,0,0,0,0,0,0,0, + 3,3,4,4,4,5,6,2,2,0,0,0,0,0,0,0,0, + 3,3,4,4,5,6,7,5,2,2,0,0,0,0,0,0,0, + 3,3,4,5,6,7,5,4,5,2,2,0,0,0,0,0,0, + 3,3,5,6,7,5,4,5,6,7,2,2,0,0,0,0,0, + 3,3,6,7,5,4,5,6,7,7,7,2,2,0,0,0,0, + 3,3,7,5,4,5,6,7,7,7,7,7,2,2,0,0,0, + 3,3,5,4,5,6,8,8,8,8,8,8,8,8,2,0,0, + 3,3,4,5,6,3,8,8,8,8,8,8,8,8,8,0,0, + 3,3,5,6,3,3,0,0,0,0,0,0,0,0,0,0,0, + 3,3,6,3,3,0,0,0,0,0,0,0,0,0,0,0,0, + 3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0, + 3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +); +const cursorPal: array[0..9*4-1] of Byte = ( + 0, 0, 0, 0, + 0, 0, 0,163, + 85,255,255,255, + 85, 85,255,255, + 255, 85, 85,255, + 170, 0,170,255, + 85, 85, 85,255, + 0, 0, 0,255, + 0, 0,170,255 +); + + +var + curtexid: GLuint = 0; + +procedure createCursorTexture (); +var + tex, tpp: PByte; + c: Integer; + x, y: Integer; +begin + if (curtexid <> 0) then exit; //begin glDeleteTextures(1, @curtexid); curtexid := 0; end; + + GetMem(tex, curTexWidth*curTexHeight*4); + try + FillChar(tex^, curTexWidth*curTexHeight*4, 0); + + // draw shadow + for y := 0 to curHeight-1 do + begin + for x := 0 to curWidth-1 do + begin + if (cursorImg[y*curWidth+x] <> 0) then + begin + c := 1*4; + tpp := tex+((y+1)*(curTexWidth*4)+(x+3)*4); + tpp^ := cursorPal[c+0]; Inc(tpp); + tpp^ := cursorPal[c+1]; Inc(tpp); + tpp^ := cursorPal[c+2]; Inc(tpp); + tpp^ := cursorPal[c+3]; Inc(tpp); + tpp^ := cursorPal[c+0]; Inc(tpp); + tpp^ := cursorPal[c+1]; Inc(tpp); + tpp^ := cursorPal[c+2]; Inc(tpp); + tpp^ := cursorPal[c+3]; Inc(tpp); + end; + end; + end; + + // draw cursor + for y := 0 to curHeight-1 do + begin + for x := 0 to curWidth-1 do + begin + c := cursorImg[y*curWidth+x]*4; + if (c <> 0) then + begin + tpp := tex+(y*(curTexWidth*4)+x*4); + tpp^ := cursorPal[c+0]; Inc(tpp); + tpp^ := cursorPal[c+1]; Inc(tpp); + tpp^ := cursorPal[c+2]; Inc(tpp); + tpp^ := cursorPal[c+3]; Inc(tpp); + end; + end; + end; + + glGenTextures(1, @curtexid); + if (curtexid = 0) then raise Exception.Create('can''t create cursor texture'); + + glBindTexture(GL_TEXTURE_2D, curtexid); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); + + //GLfloat[4] bclr = 0.0; + //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr); + + glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, curTexWidth, curTexHeight, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex); + glFlush(); + finally + FreeMem(tex); + end; +end; + +procedure oglDrawCursorAt (msX, msY: Integer); +begin + //if (curtexid = 0) then createCursorTexture() else glBindTexture(GL_TEXTURE_2D, curtexid); + glBindTexture(GL_TEXTURE_2D, curtexid); + // blend it + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_TEXTURE_2D); + glDisable(GL_STENCIL_TEST); + glDisable(GL_SCISSOR_TEST); + glDisable(GL_LIGHTING); + glDisable(GL_DEPTH_TEST); + glDisable(GL_CULL_FACE); + // color and opacity + glColor4f(1, 1, 1, 0.9); + //Dec(msX, 2); + glBegin(GL_QUADS); + glTexCoord2f(0.0, 0.0); glVertex2i(msX, msY); // top-left + glTexCoord2f(1.0, 0.0); glVertex2i(msX+curTexWidth, msY); // top-right + glTexCoord2f(1.0, 1.0); glVertex2i(msX+curTexWidth, msY+curTexHeight); // bottom-right + glTexCoord2f(0.0, 1.0); glVertex2i(msX, msY+curTexHeight); // bottom-left + glEnd(); + //Inc(msX, 2); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, 0); +end; + +procedure oglDrawCursor (); begin oglDrawCursorAt(curMsX, curMsY); end; + + +// ////////////////////////////////////////////////////////////////////////// // +// fonts +const kgiFont6: array[0..256*8-1] of Byte = ( +$00,$00,$00,$00,$00,$00,$00,$00,$3c,$42,$a5,$81,$a5,$99,$42,$3c,$3c,$7e,$db,$ff,$ff,$db,$66,$3c,$6c,$fe, +$fe,$fe,$7c,$38,$10,$00,$10,$38,$7c,$fe,$7c,$38,$10,$00,$10,$38,$54,$fe,$54,$10,$38,$00,$10,$38,$7c,$fe, +$fe,$10,$38,$00,$00,$00,$00,$30,$30,$00,$00,$00,$ff,$ff,$ff,$e7,$e7,$ff,$ff,$ff,$38,$44,$82,$82,$82,$44, +$38,$00,$c7,$bb,$7d,$7d,$7d,$bb,$c7,$ff,$0f,$03,$05,$79,$88,$88,$88,$70,$38,$44,$44,$44,$38,$10,$7c,$10, +$30,$28,$24,$24,$28,$20,$e0,$c0,$3c,$24,$3c,$24,$24,$e4,$dc,$18,$10,$54,$38,$ee,$38,$54,$10,$00,$10,$10, +$10,$7c,$10,$10,$10,$10,$10,$10,$10,$ff,$00,$00,$00,$00,$00,$00,$00,$ff,$10,$10,$10,$10,$10,$10,$10,$f0, +$10,$10,$10,$10,$10,$10,$10,$1f,$10,$10,$10,$10,$10,$10,$10,$ff,$10,$10,$10,$10,$10,$10,$10,$10,$10,$10, +$10,$10,$00,$00,$00,$ff,$00,$00,$00,$00,$00,$00,$00,$1f,$10,$10,$10,$10,$00,$00,$00,$f0,$10,$10,$10,$10, +$10,$10,$10,$1f,$00,$00,$00,$00,$10,$10,$10,$f0,$00,$00,$00,$00,$81,$42,$24,$18,$18,$24,$42,$81,$01,$02, +$04,$08,$10,$20,$40,$80,$80,$40,$20,$10,$08,$04,$02,$01,$00,$10,$10,$ff,$10,$10,$00,$00,$00,$00,$00,$00, +$00,$00,$00,$00,$20,$20,$20,$20,$00,$00,$20,$00,$50,$50,$50,$00,$00,$00,$00,$00,$50,$50,$f8,$50,$f8,$50, +$50,$00,$20,$78,$a0,$70,$28,$f0,$20,$00,$c0,$c8,$10,$20,$40,$98,$18,$00,$40,$a0,$40,$a8,$90,$98,$60,$00, +$10,$20,$40,$00,$00,$00,$00,$00,$10,$20,$40,$40,$40,$20,$10,$00,$40,$20,$10,$10,$10,$20,$40,$00,$88,$50, +$20,$f8,$20,$50,$88,$00,$00,$20,$20,$f8,$20,$20,$00,$00,$00,$00,$00,$00,$00,$20,$20,$40,$00,$00,$00,$78, +$00,$00,$00,$00,$00,$00,$00,$00,$00,$60,$60,$00,$00,$00,$08,$10,$20,$40,$80,$00,$70,$88,$98,$a8,$c8,$88, +$70,$00,$20,$60,$a0,$20,$20,$20,$f8,$00,$70,$88,$08,$10,$60,$80,$f8,$00,$70,$88,$08,$30,$08,$88,$70,$00, +$10,$30,$50,$90,$f8,$10,$10,$00,$f8,$80,$e0,$10,$08,$10,$e0,$00,$30,$40,$80,$f0,$88,$88,$70,$00,$f8,$88, +$10,$20,$20,$20,$20,$00,$70,$88,$88,$70,$88,$88,$70,$00,$70,$88,$88,$78,$08,$10,$60,$00,$00,$00,$20,$00, +$00,$20,$00,$00,$00,$00,$20,$00,$00,$20,$20,$40,$18,$30,$60,$c0,$60,$30,$18,$00,$00,$00,$f8,$00,$f8,$00, +$00,$00,$c0,$60,$30,$18,$30,$60,$c0,$00,$70,$88,$08,$10,$20,$00,$20,$00,$70,$88,$08,$68,$a8,$a8,$70,$00, +$20,$50,$88,$88,$f8,$88,$88,$00,$f0,$48,$48,$70,$48,$48,$f0,$00,$30,$48,$80,$80,$80,$48,$30,$00,$e0,$50, +$48,$48,$48,$50,$e0,$00,$f8,$80,$80,$f0,$80,$80,$f8,$00,$f8,$80,$80,$f0,$80,$80,$80,$00,$70,$88,$80,$b8, +$88,$88,$70,$00,$88,$88,$88,$f8,$88,$88,$88,$00,$70,$20,$20,$20,$20,$20,$70,$00,$38,$10,$10,$10,$90,$90, +$60,$00,$88,$90,$a0,$c0,$a0,$90,$88,$00,$80,$80,$80,$80,$80,$80,$f8,$00,$88,$d8,$a8,$a8,$88,$88,$88,$00, +$88,$c8,$c8,$a8,$98,$98,$88,$00,$70,$88,$88,$88,$88,$88,$70,$00,$f0,$88,$88,$f0,$80,$80,$80,$00,$70,$88, +$88,$88,$a8,$90,$68,$00,$f0,$88,$88,$f0,$a0,$90,$88,$00,$70,$88,$80,$70,$08,$88,$70,$00,$f8,$20,$20,$20, +$20,$20,$20,$00,$88,$88,$88,$88,$88,$88,$70,$00,$88,$88,$88,$88,$50,$50,$20,$00,$88,$88,$88,$a8,$a8,$d8, +$88,$00,$88,$88,$50,$20,$50,$88,$88,$00,$88,$88,$88,$70,$20,$20,$20,$00,$f8,$08,$10,$20,$40,$80,$f8,$00, +$70,$40,$40,$40,$40,$40,$70,$00,$00,$00,$80,$40,$20,$10,$08,$00,$70,$10,$10,$10,$10,$10,$70,$00,$20,$50, +$88,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$f8,$00,$40,$20,$10,$00,$00,$00,$00,$00,$00,$00,$70,$08, +$78,$88,$78,$00,$80,$80,$b0,$c8,$88,$c8,$b0,$00,$00,$00,$70,$88,$80,$88,$70,$00,$08,$08,$68,$98,$88,$98, +$68,$00,$00,$00,$70,$88,$f8,$80,$70,$00,$10,$28,$20,$f8,$20,$20,$20,$00,$00,$00,$68,$98,$98,$68,$08,$70, +$80,$80,$f0,$88,$88,$88,$88,$00,$20,$00,$60,$20,$20,$20,$70,$00,$10,$00,$30,$10,$10,$10,$90,$60,$40,$40, +$48,$50,$60,$50,$48,$00,$60,$20,$20,$20,$20,$20,$70,$00,$00,$00,$d0,$a8,$a8,$a8,$a8,$00,$00,$00,$b0,$c8, +$88,$88,$88,$00,$00,$00,$70,$88,$88,$88,$70,$00,$00,$00,$b0,$c8,$c8,$b0,$80,$80,$00,$00,$68,$98,$98,$68, +$08,$08,$00,$00,$b0,$c8,$80,$80,$80,$00,$00,$00,$78,$80,$f0,$08,$f0,$00,$40,$40,$f0,$40,$40,$48,$30,$00, +$00,$00,$90,$90,$90,$90,$68,$00,$00,$00,$88,$88,$88,$50,$20,$00,$00,$00,$88,$a8,$a8,$a8,$50,$00,$00,$00, +$88,$50,$20,$50,$88,$00,$00,$00,$88,$88,$98,$68,$08,$70,$00,$00,$f8,$10,$20,$40,$f8,$00,$18,$20,$20,$40, +$20,$20,$18,$00,$20,$20,$20,$00,$20,$20,$20,$00,$c0,$20,$20,$10,$20,$20,$c0,$00,$40,$a8,$10,$00,$00,$00, +$00,$00,$00,$00,$20,$50,$f8,$00,$00,$00,$00,$00,$00,$00,$00,$00,$ff,$ff,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f, +$00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$00,$00,$00,$00,$00,$3c,$3c,$00,$00,$00,$ff,$ff, +$ff,$ff,$ff,$ff,$00,$00,$c0,$c0,$c0,$c0,$c0,$c0,$c0,$c0,$0f,$0f,$0f,$0f,$f0,$f0,$f0,$f0,$fc,$fc,$fc,$fc, +$fc,$fc,$fc,$fc,$03,$03,$03,$03,$03,$03,$03,$03,$3f,$3f,$3f,$3f,$3f,$3f,$3f,$3f,$11,$22,$44,$88,$11,$22, +$44,$88,$88,$44,$22,$11,$88,$44,$22,$11,$fe,$7c,$38,$10,$00,$00,$00,$00,$00,$00,$00,$00,$10,$38,$7c,$fe, +$80,$c0,$e0,$f0,$e0,$c0,$80,$00,$01,$03,$07,$0f,$07,$03,$01,$00,$ff,$7e,$3c,$18,$18,$3c,$7e,$ff,$81,$c3, +$e7,$ff,$ff,$e7,$c3,$81,$f0,$f0,$f0,$f0,$00,$00,$00,$00,$00,$00,$00,$00,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f, +$00,$00,$00,$00,$00,$00,$00,$00,$f0,$f0,$f0,$f0,$33,$33,$cc,$cc,$33,$33,$cc,$cc,$00,$20,$20,$50,$50,$88, +$f8,$00,$20,$20,$70,$20,$70,$20,$20,$00,$00,$00,$00,$50,$88,$a8,$50,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff, +$00,$00,$00,$00,$ff,$ff,$ff,$ff,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$ff,$ff, +$ff,$ff,$00,$00,$00,$00,$00,$00,$68,$90,$90,$90,$68,$00,$30,$48,$48,$70,$48,$48,$70,$c0,$f8,$88,$80,$80, +$80,$80,$80,$00,$00,$50,$70,$88,$f8,$80,$70,$00,$00,$00,$78,$80,$f0,$80,$78,$00,$00,$00,$78,$90,$90,$90, +$60,$00,$20,$00,$60,$20,$20,$20,$70,$00,$50,$00,$70,$20,$20,$20,$70,$00,$f8,$20,$70,$a8,$a8,$70,$20,$f8, +$20,$50,$88,$f8,$88,$50,$20,$00,$70,$88,$88,$88,$50,$50,$d8,$00,$30,$40,$40,$20,$50,$50,$50,$20,$00,$00, +$00,$50,$a8,$a8,$50,$00,$08,$70,$a8,$a8,$a8,$70,$80,$00,$38,$40,$80,$f8,$80,$40,$38,$00,$70,$88,$88,$88, +$88,$88,$88,$00,$00,$f8,$00,$f8,$00,$f8,$00,$00,$20,$20,$f8,$20,$20,$00,$f8,$00,$c0,$30,$08,$30,$c0,$00, +$f8,$00,$50,$f8,$80,$f0,$80,$80,$f8,$00,$78,$80,$80,$f0,$80,$80,$78,$00,$20,$20,$20,$20,$20,$20,$a0,$40, +$70,$20,$20,$20,$20,$20,$70,$00,$50,$70,$20,$20,$20,$20,$70,$00,$00,$18,$24,$24,$18,$00,$00,$00,$00,$30, +$78,$78,$30,$00,$00,$00,$00,$00,$00,$00,$30,$00,$00,$00,$3e,$20,$20,$20,$a0,$60,$20,$00,$a0,$50,$50,$50, +$00,$00,$00,$00,$40,$a0,$20,$40,$e0,$00,$00,$00,$00,$38,$38,$38,$38,$38,$38,$00,$3c,$42,$99,$a1,$a1,$99, +$42,$3c,$00,$00,$90,$a8,$e8,$a8,$90,$00,$00,$00,$60,$10,$70,$90,$68,$00,$00,$00,$f0,$80,$f0,$88,$f0,$00, +$00,$00,$90,$90,$90,$f8,$08,$00,$00,$00,$30,$50,$50,$70,$88,$00,$00,$00,$70,$88,$f8,$80,$70,$00,$00,$20, +$70,$a8,$a8,$70,$20,$00,$00,$00,$78,$48,$40,$40,$40,$00,$00,$00,$88,$50,$20,$50,$88,$00,$00,$00,$88,$98, +$a8,$c8,$88,$00,$00,$50,$20,$00,$98,$a8,$c8,$00,$00,$00,$90,$a0,$c0,$a0,$90,$00,$00,$00,$38,$28,$28,$48, +$88,$00,$00,$00,$88,$d8,$a8,$88,$88,$00,$00,$00,$88,$88,$f8,$88,$88,$00,$00,$00,$70,$88,$88,$88,$70,$00, +$00,$00,$78,$48,$48,$48,$48,$00,$00,$00,$78,$88,$78,$28,$48,$00,$00,$00,$f0,$88,$f0,$80,$80,$00,$00,$00, +$78,$80,$80,$80,$78,$00,$00,$00,$f8,$20,$20,$20,$20,$00,$00,$00,$88,$50,$20,$40,$80,$00,$00,$00,$a8,$70, +$20,$70,$a8,$00,$00,$00,$f0,$48,$70,$48,$f0,$00,$00,$00,$40,$40,$70,$48,$70,$00,$00,$00,$88,$88,$c8,$a8, +$c8,$00,$00,$00,$f0,$08,$70,$08,$f0,$00,$00,$00,$a8,$a8,$a8,$a8,$f8,$00,$00,$00,$70,$88,$38,$88,$70,$00, +$00,$00,$a8,$a8,$a8,$f8,$08,$00,$00,$00,$48,$48,$78,$08,$08,$00,$00,$00,$c0,$40,$70,$48,$70,$00,$90,$a8, +$a8,$e8,$a8,$a8,$90,$00,$20,$50,$88,$88,$f8,$88,$88,$00,$f8,$88,$80,$f0,$88,$88,$f0,$00,$90,$90,$90,$90, +$90,$f8,$08,$00,$38,$28,$28,$48,$48,$f8,$88,$00,$f8,$80,$80,$f0,$80,$80,$f8,$00,$20,$70,$a8,$a8,$a8,$70, +$20,$00,$f8,$88,$88,$80,$80,$80,$80,$00,$88,$88,$50,$20,$50,$88,$88,$00,$88,$88,$98,$a8,$c8,$88,$88,$00, +$50,$20,$88,$98,$a8,$c8,$88,$00,$88,$90,$a0,$c0,$a0,$90,$88,$00,$18,$28,$48,$48,$48,$48,$88,$00,$88,$d8, +$a8,$a8,$88,$88,$88,$00,$88,$88,$88,$f8,$88,$88,$88,$00,$70,$88,$88,$88,$88,$88,$70,$00,$f8,$88,$88,$88, +$88,$88,$88,$00,$78,$88,$88,$78,$28,$48,$88,$00,$f0,$88,$88,$f0,$80,$80,$80,$00,$70,$88,$80,$80,$80,$88, +$70,$00,$f8,$20,$20,$20,$20,$20,$20,$00,$88,$88,$88,$50,$20,$40,$80,$00,$a8,$a8,$70,$20,$70,$a8,$a8,$00, +$f0,$48,$48,$70,$48,$48,$f0,$00,$80,$80,$80,$f0,$88,$88,$f0,$00,$88,$88,$88,$c8,$a8,$a8,$c8,$00,$f0,$08, +$08,$30,$08,$08,$f0,$00,$a8,$a8,$a8,$a8,$a8,$a8,$f8,$00,$70,$88,$08,$78,$08,$88,$70,$00,$a8,$a8,$a8,$a8, +$a8,$f8,$08,$00,$88,$88,$88,$88,$78,$08,$08,$00,$c0,$40,$40,$70,$48,$48,$70,$00 +); + +const kgiFont8: array[0..256*8-1] of Byte = ( +$00,$00,$00,$00,$00,$00,$00,$00,$7e,$81,$a5,$81,$bd,$99,$81,$7e,$7e,$ff,$db,$ff,$c3,$e7,$ff,$7e,$6c,$fe, +$fe,$fe,$7c,$38,$10,$00,$10,$38,$7c,$fe,$7c,$38,$10,$00,$38,$7c,$38,$fe,$fe,$d6,$10,$38,$10,$10,$38,$7c, +$fe,$7c,$10,$38,$00,$00,$18,$3c,$3c,$18,$00,$00,$ff,$ff,$e7,$c3,$c3,$e7,$ff,$ff,$00,$3c,$66,$42,$42,$66, +$3c,$00,$ff,$c3,$99,$bd,$bd,$99,$c3,$ff,$0f,$07,$0f,$7d,$cc,$cc,$cc,$78,$3c,$66,$66,$66,$3c,$18,$7e,$18, +$3f,$33,$3f,$30,$30,$70,$f0,$e0,$7f,$63,$7f,$63,$63,$67,$e6,$c0,$99,$5a,$3c,$e7,$e7,$3c,$5a,$99,$80,$e0, +$f8,$fe,$f8,$e0,$80,$00,$02,$0e,$3e,$fe,$3e,$0e,$02,$00,$18,$3c,$7e,$18,$18,$7e,$3c,$18,$66,$66,$66,$66, +$66,$00,$66,$00,$7f,$db,$db,$7b,$1b,$1b,$1b,$00,$7e,$c3,$78,$cc,$cc,$78,$8c,$f8,$00,$00,$00,$00,$7e,$7e, +$7e,$00,$18,$3c,$7e,$18,$7e,$3c,$18,$ff,$18,$3c,$7e,$18,$18,$18,$18,$00,$18,$18,$18,$18,$7e,$3c,$18,$00, +$00,$18,$0c,$fe,$0c,$18,$00,$00,$00,$30,$60,$fe,$60,$30,$00,$00,$00,$00,$c0,$c0,$c0,$fe,$00,$00,$00,$24, +$66,$ff,$66,$24,$00,$00,$00,$18,$3c,$7e,$ff,$ff,$00,$00,$00,$ff,$ff,$7e,$3c,$18,$00,$00,$00,$00,$00,$00, +$00,$00,$00,$00,$30,$78,$78,$30,$30,$00,$30,$00,$6c,$6c,$6c,$00,$00,$00,$00,$00,$6c,$6c,$fe,$6c,$fe,$6c, +$6c,$00,$30,$7c,$c0,$78,$0c,$f8,$30,$00,$00,$c6,$cc,$18,$30,$66,$c6,$00,$38,$6c,$38,$76,$dc,$cc,$76,$00, +$60,$60,$c0,$00,$00,$00,$00,$00,$18,$30,$60,$60,$60,$30,$18,$00,$60,$30,$18,$18,$18,$30,$60,$00,$00,$66, +$3c,$ff,$3c,$66,$00,$00,$00,$30,$30,$fc,$30,$30,$00,$00,$00,$00,$00,$00,$00,$70,$30,$60,$00,$00,$00,$fc, +$00,$00,$00,$00,$00,$00,$00,$00,$00,$30,$30,$00,$06,$0c,$18,$30,$60,$c0,$80,$00,$78,$cc,$dc,$fc,$ec,$cc, +$78,$00,$30,$f0,$30,$30,$30,$30,$fc,$00,$78,$cc,$0c,$38,$60,$cc,$fc,$00,$78,$cc,$0c,$38,$0c,$cc,$78,$00, +$1c,$3c,$6c,$cc,$fe,$0c,$0c,$00,$fc,$c0,$f8,$0c,$0c,$cc,$78,$00,$38,$60,$c0,$f8,$cc,$cc,$78,$00,$fc,$cc, +$0c,$18,$30,$60,$60,$00,$78,$cc,$cc,$78,$cc,$cc,$78,$00,$78,$cc,$cc,$7c,$0c,$18,$70,$00,$00,$00,$30,$30, +$00,$30,$30,$00,$00,$00,$30,$30,$00,$70,$30,$60,$18,$30,$60,$c0,$60,$30,$18,$00,$00,$00,$fc,$00,$fc,$00, +$00,$00,$60,$30,$18,$0c,$18,$30,$60,$00,$78,$cc,$0c,$18,$30,$00,$30,$00,$7c,$c6,$de,$de,$de,$c0,$78,$00, +$30,$78,$cc,$cc,$fc,$cc,$cc,$00,$fc,$66,$66,$7c,$66,$66,$fc,$00,$3c,$66,$c0,$c0,$c0,$66,$3c,$00,$fc,$6c, +$66,$66,$66,$6c,$fc,$00,$fe,$62,$68,$78,$68,$62,$fe,$00,$fe,$62,$68,$78,$68,$60,$f0,$00,$3c,$66,$c0,$c0, +$ce,$66,$3e,$00,$cc,$cc,$cc,$fc,$cc,$cc,$cc,$00,$78,$30,$30,$30,$30,$30,$78,$00,$1e,$0c,$0c,$0c,$cc,$cc, +$78,$00,$e6,$66,$6c,$78,$6c,$66,$e6,$00,$f0,$60,$60,$60,$62,$66,$fe,$00,$c6,$ee,$fe,$d6,$c6,$c6,$c6,$00, +$c6,$e6,$f6,$de,$ce,$c6,$c6,$00,$38,$6c,$c6,$c6,$c6,$6c,$38,$00,$fc,$66,$66,$7c,$60,$60,$f0,$00,$78,$cc, +$cc,$cc,$dc,$78,$1c,$00,$fc,$66,$66,$7c,$78,$6c,$e6,$00,$78,$cc,$e0,$38,$1c,$cc,$78,$00,$fc,$b4,$30,$30, +$30,$30,$78,$00,$cc,$cc,$cc,$cc,$cc,$cc,$fc,$00,$cc,$cc,$cc,$cc,$cc,$78,$30,$00,$c6,$c6,$c6,$d6,$fe,$ee, +$c6,$00,$c6,$c6,$6c,$38,$6c,$c6,$c6,$00,$cc,$cc,$cc,$78,$30,$30,$78,$00,$fe,$cc,$98,$30,$62,$c6,$fe,$00, +$78,$60,$60,$60,$60,$60,$78,$00,$c0,$60,$30,$18,$0c,$06,$02,$00,$78,$18,$18,$18,$18,$18,$78,$00,$10,$38, +$6c,$c6,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$ff,$30,$30,$18,$00,$00,$00,$00,$00,$00,$00,$78,$0c, +$7c,$cc,$76,$00,$e0,$60,$7c,$66,$66,$66,$bc,$00,$00,$00,$78,$cc,$c0,$cc,$78,$00,$1c,$0c,$0c,$7c,$cc,$cc, +$76,$00,$00,$00,$78,$cc,$fc,$c0,$78,$00,$38,$6c,$60,$f0,$60,$60,$f0,$00,$00,$00,$76,$cc,$cc,$7c,$0c,$f8, +$e0,$60,$6c,$76,$66,$66,$e6,$00,$30,$00,$70,$30,$30,$30,$78,$00,$18,$00,$78,$18,$18,$18,$d8,$70,$e0,$60, +$66,$6c,$78,$6c,$e6,$00,$70,$30,$30,$30,$30,$30,$78,$00,$00,$00,$ec,$fe,$d6,$c6,$c6,$00,$00,$00,$f8,$cc, +$cc,$cc,$cc,$00,$00,$00,$78,$cc,$cc,$cc,$78,$00,$00,$00,$dc,$66,$66,$7c,$60,$f0,$00,$00,$76,$cc,$cc,$7c, +$0c,$1e,$00,$00,$d8,$6c,$6c,$60,$f0,$00,$00,$00,$7c,$c0,$78,$0c,$f8,$00,$10,$30,$7c,$30,$30,$34,$18,$00, +$00,$00,$cc,$cc,$cc,$cc,$76,$00,$00,$00,$cc,$cc,$cc,$78,$30,$00,$00,$00,$c6,$c6,$d6,$fe,$6c,$00,$00,$00, +$c6,$6c,$38,$6c,$c6,$00,$00,$00,$cc,$cc,$cc,$7c,$0c,$f8,$00,$00,$fc,$98,$30,$64,$fc,$00,$1c,$30,$30,$e0, +$30,$30,$1c,$00,$18,$18,$18,$00,$18,$18,$18,$00,$e0,$30,$30,$1c,$30,$30,$e0,$00,$76,$dc,$00,$00,$00,$00, +$00,$00,$10,$38,$6c,$c6,$c6,$c6,$fe,$00,$78,$cc,$c0,$cc,$78,$18,$0c,$78,$00,$cc,$00,$cc,$cc,$cc,$7e,$00, +$1c,$00,$78,$cc,$fc,$c0,$78,$00,$7e,$c3,$3c,$06,$3e,$66,$3f,$00,$cc,$00,$78,$0c,$7c,$cc,$7e,$00,$e0,$00, +$78,$0c,$7c,$cc,$7e,$00,$30,$30,$78,$0c,$7c,$cc,$7e,$00,$00,$00,$7c,$c0,$c0,$7c,$06,$3c,$7e,$c3,$3c,$66, +$7e,$60,$3c,$00,$cc,$00,$78,$cc,$fc,$c0,$78,$00,$e0,$00,$78,$cc,$fc,$c0,$78,$00,$cc,$00,$70,$30,$30,$30, +$78,$00,$7c,$c6,$38,$18,$18,$18,$3c,$00,$e0,$00,$70,$30,$30,$30,$78,$00,$cc,$30,$78,$cc,$cc,$fc,$cc,$00, +$30,$30,$00,$78,$cc,$fc,$cc,$00,$1c,$00,$fc,$60,$78,$60,$fc,$00,$00,$00,$7f,$0c,$7f,$cc,$7f,$00,$3e,$6c, +$cc,$fe,$cc,$cc,$ce,$00,$78,$cc,$00,$78,$cc,$cc,$78,$00,$00,$cc,$00,$78,$cc,$cc,$78,$00,$00,$e0,$00,$78, +$cc,$cc,$78,$00,$78,$cc,$00,$cc,$cc,$cc,$7e,$00,$00,$e0,$00,$cc,$cc,$cc,$7e,$00,$00,$cc,$00,$cc,$cc,$fc, +$0c,$f8,$c6,$38,$7c,$c6,$c6,$7c,$38,$00,$cc,$00,$cc,$cc,$cc,$cc,$78,$00,$18,$18,$7e,$c0,$c0,$7e,$18,$18, +$38,$6c,$64,$f0,$60,$e6,$fc,$00,$cc,$cc,$78,$fc,$30,$fc,$30,$00,$f0,$d8,$d8,$f4,$cc,$de,$cc,$0e,$0e,$1b, +$18,$7e,$18,$18,$d8,$70,$1c,$00,$78,$0c,$7c,$cc,$7e,$00,$38,$00,$70,$30,$30,$30,$78,$00,$00,$1c,$00,$78, +$cc,$cc,$78,$00,$00,$1c,$00,$cc,$cc,$cc,$7e,$00,$00,$f8,$00,$f8,$cc,$cc,$cc,$00,$fc,$00,$cc,$ec,$fc,$dc, +$cc,$00,$3c,$6c,$6c,$3e,$00,$7e,$00,$00,$3c,$66,$66,$3c,$00,$7e,$00,$00,$30,$00,$30,$60,$c0,$cc,$78,$00, +$00,$00,$00,$fc,$c0,$c0,$00,$00,$00,$00,$00,$fc,$0c,$0c,$00,$00,$c6,$cc,$d8,$3e,$63,$ce,$98,$1f,$c6,$cc, +$d8,$f3,$67,$cf,$9f,$03,$00,$18,$00,$18,$18,$3c,$3c,$18,$00,$33,$66,$cc,$66,$33,$00,$00,$00,$cc,$66,$33, +$66,$cc,$00,$00,$22,$88,$22,$88,$22,$88,$22,$88,$55,$aa,$55,$aa,$55,$aa,$55,$aa,$dc,$76,$dc,$76,$dc,$76, +$dc,$76,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$f8,$18,$18,$18,$18,$18,$f8,$18,$f8,$18,$18,$18, +$36,$36,$36,$36,$f6,$36,$36,$36,$00,$00,$00,$00,$fe,$36,$36,$36,$00,$00,$f8,$18,$f8,$18,$18,$18,$36,$36, +$f6,$06,$f6,$36,$36,$36,$36,$36,$36,$36,$36,$36,$36,$36,$00,$00,$fe,$06,$f6,$36,$36,$36,$36,$36,$f6,$06, +$fe,$00,$00,$00,$36,$36,$36,$36,$fe,$00,$00,$00,$18,$18,$f8,$18,$f8,$00,$00,$00,$00,$00,$00,$00,$f8,$18, +$18,$18,$18,$18,$18,$18,$1f,$00,$00,$00,$18,$18,$18,$18,$ff,$00,$00,$00,$00,$00,$00,$00,$ff,$18,$18,$18, +$18,$18,$18,$18,$1f,$18,$18,$18,$00,$00,$00,$00,$ff,$00,$00,$00,$18,$18,$18,$18,$ff,$18,$18,$18,$18,$18, +$1f,$18,$1f,$18,$18,$18,$36,$36,$36,$36,$37,$36,$36,$36,$36,$36,$37,$30,$3f,$00,$00,$00,$00,$00,$3f,$30, +$37,$36,$36,$36,$36,$36,$f7,$00,$ff,$00,$00,$00,$00,$00,$ff,$00,$f7,$36,$36,$36,$36,$36,$37,$30,$37,$36, +$36,$36,$00,$00,$ff,$00,$ff,$00,$00,$00,$36,$36,$f7,$00,$f7,$36,$36,$36,$18,$18,$ff,$00,$ff,$00,$00,$00, +$36,$36,$36,$36,$ff,$00,$00,$00,$00,$00,$ff,$00,$ff,$18,$18,$18,$00,$00,$00,$00,$ff,$36,$36,$36,$36,$36, +$36,$36,$3f,$00,$00,$00,$18,$18,$1f,$18,$1f,$00,$00,$00,$00,$00,$1f,$18,$1f,$18,$18,$18,$00,$00,$00,$00, +$3f,$36,$36,$36,$36,$36,$36,$36,$f7,$36,$36,$36,$18,$18,$ff,$00,$ff,$18,$18,$18,$18,$18,$18,$18,$f8,$00, +$00,$00,$00,$00,$00,$00,$1f,$18,$18,$18,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$ff,$ff,$ff,$ff, +$f0,$f0,$f0,$f0,$f0,$f0,$f0,$f0,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$0f,$ff,$ff,$ff,$ff,$00,$00,$00,$00,$00,$00, +$76,$dc,$c8,$dc,$76,$00,$00,$78,$cc,$f8,$cc,$f8,$c0,$c0,$00,$fe,$c6,$c0,$c0,$c0,$c0,$00,$00,$fe,$6c,$6c, +$6c,$6c,$6c,$00,$fe,$66,$30,$18,$30,$66,$fe,$00,$00,$00,$7e,$cc,$cc,$cc,$78,$00,$00,$66,$66,$66,$66,$7c, +$60,$c0,$00,$76,$dc,$18,$18,$18,$18,$00,$fc,$30,$78,$cc,$cc,$78,$30,$fc,$38,$6c,$c6,$fe,$c6,$6c,$38,$00, +$38,$6c,$c6,$c6,$6c,$6c,$ee,$00,$1c,$30,$18,$7c,$cc,$cc,$78,$00,$00,$00,$7e,$db,$db,$7e,$00,$00,$06,$0c, +$7e,$db,$db,$7e,$60,$c0,$3c,$60,$c0,$fc,$c0,$60,$3c,$00,$78,$cc,$cc,$cc,$cc,$cc,$cc,$00,$00,$fc,$00,$fc, +$00,$fc,$00,$00,$30,$30,$fc,$30,$30,$00,$fc,$00,$60,$30,$18,$30,$60,$00,$fc,$00,$18,$30,$60,$30,$18,$00, +$fc,$00,$0e,$1b,$1b,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$d8,$d8,$70,$30,$30,$00,$fc,$00,$30,$30,$00, +$00,$72,$9c,$00,$72,$9c,$00,$00,$38,$6c,$6c,$38,$00,$00,$00,$00,$00,$00,$00,$18,$18,$00,$00,$00,$00,$00, +$00,$00,$18,$00,$00,$00,$0f,$0c,$0c,$0c,$ec,$6c,$3c,$1c,$78,$6c,$6c,$6c,$6c,$00,$00,$00,$78,$0c,$38,$60, +$7c,$00,$00,$00,$00,$00,$3c,$3c,$3c,$3c,$00,$00,$ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff +); + +const kgiFont6PropWidth: array[0..256-1] of Byte = ( + $08,$08,$08,$07,$07,$07,$07,$04,$08,$07,$08,$08,$06,$06,$06,$07, + $06,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08, + $85,$21,$13,$05,$05,$05,$05,$13,$13,$13,$05,$05,$12,$14,$12,$05, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$21,$12,$05,$05,$05,$05, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$05,$05,$05,$05,$05, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$13,$05,$13,$05,$05, + $13,$05,$05,$05,$05,$05,$05,$05,$05,$13,$04,$14,$13,$05,$05,$05, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$14,$21,$04,$05,$08, + $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$04, + $44,$08,$08,$08,$08,$08,$08,$08,$05,$04,$05,$08,$08,$08,$08,$08, + $05,$05,$05,$05,$05,$05,$13,$13,$05,$05,$05,$04,$05,$05,$05,$05, + $05,$05,$05,$05,$05,$03,$04,$04,$06,$05,$04,$07,$04,$03,$05,$08, + $05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$04,$05,$05,$05,$05, + $14,$05,$05,$05,$05,$05,$05,$05,$14,$05,$05,$05,$05,$05,$14,$05, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$05 +); + +const kgiFont8PropWidth: array[0..256-1] of Byte = ( + $08,$08,$08,$07,$07,$07,$07,$06,$08,$07,$08,$08,$07,$08,$08,$08, + $07,$07,$07,$07,$08,$08,$07,$08,$07,$07,$07,$07,$07,$08,$08,$08, + $85,$14,$15,$07,$06,$07,$07,$03,$14,$14,$08,$06,$13,$06,$22,$07, + $05,$05,$05,$05,$05,$05,$05,$05,$05,$05,$22,$13,$05,$06,$15,$06, + $07,$06,$07,$07,$07,$07,$07,$07,$06,$14,$07,$07,$07,$07,$07,$07, + $07,$06,$07,$06,$06,$06,$06,$07,$07,$06,$07,$14,$07,$14,$07,$08, + $23,$07,$07,$06,$07,$06,$06,$07,$07,$14,$05,$07,$14,$07,$06,$06, + $07,$07,$06,$06,$15,$07,$06,$07,$07,$06,$06,$06,$32,$06,$07,$07, + $06,$07,$06,$08,$07,$07,$07,$07,$08,$06,$06,$06,$07,$05,$06,$06, + $06,$08,$07,$06,$06,$06,$07,$07,$06,$07,$06,$07,$07,$06,$07,$08, + $07,$05,$06,$07,$06,$06,$16,$16,$06,$06,$06,$08,$08,$06,$08,$08, + $08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08, + $38,$08,$08,$38,$08,$08,$38,$28,$28,$28,$08,$08,$28,$08,$08,$08, + $08,$08,$08,$28,$38,$38,$28,$08,$08,$08,$38,$08,$08,$08,$48,$08, + $07,$06,$07,$07,$07,$07,$07,$07,$06,$07,$07,$06,$08,$08,$06,$06, + $06,$06,$06,$06,$35,$05,$06,$07,$15,$32,$32,$08,$15,$15,$24,$08 +); + + +function createFontTexture (constref font: array of Byte; constref fontwdt: array of Byte; prop: Boolean): GLuint; +const + Width = 16*8; + Height = 16*8; +var + tex, tpp: PByte; + b: Byte; + cc: Integer; + x, y, dx, dy: Integer; +begin + GetMem(tex, Width*Height*4); + + for cc := 0 to 255 do + begin + x := (cc mod 16)*8; + y := (cc div 16)*8; + for dy := 0 to 7 do + begin + b := font[cc*8+dy]; + if prop then b := b shl (fontwdt[cc] shr 4); + tpp := tex+((y+dy)*(Width*4))+x*4; + for dx := 0 to 7 do + begin + if ((b and $80) <> 0) then + begin + tpp^ := 255; Inc(tpp); + tpp^ := 255; Inc(tpp); + tpp^ := 255; Inc(tpp); + tpp^ := 255; Inc(tpp); + end + else + begin + tpp^ := 0; Inc(tpp); + tpp^ := 0; Inc(tpp); + tpp^ := 0; Inc(tpp); + tpp^ := 0; Inc(tpp); + end; + b := (b and $7f) shl 1; + end; + end; + end; + + glGenTextures(1, @result); + if (result = 0) then raise Exception.Create('can''t create Holmes font texture'); + + glBindTexture(GL_TEXTURE_2D, result); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); + + //GLfloat[4] bclr = 0.0; + //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr); + + glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex); + glFlush(); + + //FreeMem(tex); +end; + + +var + font6texid: GLuint = 0; + font8texid: GLuint = 0; + prfont6texid: GLuint = 0; + prfont8texid: GLuint = 0; + + +procedure deleteFonts (); +begin + if (font6texid <> 0) then glDeleteTextures(1, @font6texid); + if (font8texid <> 0) then glDeleteTextures(1, @font8texid); + if (prfont6texid <> 0) then glDeleteTextures(1, @prfont6texid); + if (prfont8texid <> 0) then glDeleteTextures(1, @prfont8texid); + font6texid := 0; + font8texid := 0; + prfont6texid := 0; + prfont8texid := 0; +end; + + +procedure createFonts (); +begin + if (font6texid = 0) then font6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, false); + if (font8texid = 0) then font8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, false); + if (prfont6texid = 0) then prfont6texid := createFontTexture(kgiFont6, kgiFont6PropWidth, true); + if (prfont8texid = 0) then prfont8texid := createFontTexture(kgiFont8, kgiFont8PropWidth, true); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure TScissorSave.save (enableScissoring: Boolean); +begin + wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0); + if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]); + //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]); + if enableScissoring then glEnable(GL_SCISSOR_TEST); +end; + +procedure TScissorSave.restore (); +begin + glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]); + if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST); +end; + +procedure TScissorSave.setRect (x, y, w, h: Integer); +begin + if (w < 1) or (h < 1) then begin glScissor(0, 0, 0, 0); exit; end; + y := gScrHeight-(y+h); + if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h); +end; + +//TODO: overflow checks +function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; +var + ex0, ey0: Integer; +begin + result := false; + if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; + // check for intersection + if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit; + if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit; + // ok, intersects + ex0 := x0+w0; + ey0 := y0+h0; + if (x0 < x1) then x0 := x1; + if (y0 < y1) then y0 := y1; + if (ex0 > x1+w1) then ex0 := x1+w1; + if (ey0 > y1+h1) then ey0 := y1+h1; + w0 := ex0-x0; + h0 := ey0-y0; + result := (w0 > 0) and (h0 > 0); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure normRGBA (var r, g, b, a: Integer); inline; +begin + if (a < 0) then a := 0 else if (a > 255) then a := 255; + if (r < 0) then r := 0 else if (r > 255) then r := 255; + if (g < 0) then g := 0 else if (g > 255) then g := 255; + if (b < 0) then b := 0 else if (b > 255) then b := 255; +end; + +// returns `false` if the color is transparent +function setupGLColor (r, g, b, a: Integer): Boolean; +begin + normRGBA(r, g, b, a); + if (a < 255) then + begin + if (a = 0) then begin result := false; exit; end; + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end + else + begin + glDisable(GL_BLEND); + end; + glColor4ub(Byte(r), Byte(g), Byte(b), Byte(a)); + result := true; +end; + +function isScaled (): Boolean; +var + mt: packed array [0..15] of Double; +begin + glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]); + result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function textWidth6 (const s: AnsiString): Integer; +var + f: Integer; +begin + result := 0; + for f := 1 to Length(s) do Inc(result, Integer(kgiFont6PropWidth[Integer(s[f])] and $0f)+1); + if (result > 0) then Dec(result); // don't count last empty pixel +end; + + +function textWidth8 (const s: AnsiString): Integer; +var + f: Integer; +begin + result := 0; + for f := 1 to Length(s) do Inc(result, Integer(kgiFont8PropWidth[Integer(s[f])] and $0f)+1); + if (result > 0) then Dec(result); // don't count last empty pixel +end; + + +// return width (including last empty pixel) +function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer; +var + f, c: Integer; + tx, ty: Integer; +begin + result := 0; + if (Length(s) = 0) then exit; + if not setupGLColor(r, g, b, a) then exit; + + glEnable(GL_ALPHA_TEST); + glAlphaFunc(GL_NOTEQUAL, 0.0); + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, tid); + + for f := 1 to Length(s) do + begin + c := Integer(s[f]) and $ff; + tx := (c mod 16)*8; + ty := (c div 16)*8; + glBegin(GL_QUADS); + glTexCoord2f((tx+0)/128.0, (ty+0)/128.0); glVertex2i(x+0, y+0); // top-left + glTexCoord2f((tx+8)/128.0, (ty+0)/128.0); glVertex2i(x+8, y+0); // top-right + glTexCoord2f((tx+8)/128.0, (ty+8)/128.0); glVertex2i(x+8, y+8); // bottom-right + glTexCoord2f((tx+0)/128.0, (ty+8)/128.0); glVertex2i(x+0, y+8); // bottom-left + glEnd(); + if prop then + begin + x += Integer(fontwdt[c] and $0f)+1; + result += Integer(fontwdt[c] and $0f)+1; + end + else + begin + x += wdt; + result += wdt; + end; + end; + + glDisable(GL_ALPHA_TEST); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, 0); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255); +begin + if (len < 1) then exit; + if not setupGLColor(r, g, b, a) then exit; + glDisable(GL_TEXTURE_2D); + if (not isScaled) then + begin + glBegin(GL_LINES); + glVertex2f(x+0.375, y+0.375); + glVertex2f(x+len+0.375, y+0.375); + glEnd(); + end + else + begin + glBegin(GL_QUADS); + glVertex2i(x, y); + glVertex2i(x+len, y); + glVertex2i(x+len, y+1); + glVertex2i(x, y+1); + glEnd(); + end; +end; + + +procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255); +begin + if (len < 1) then exit; + if not setupGLColor(r, g, b, a) then exit; + glDisable(GL_TEXTURE_2D); + if (not isScaled) then + begin + glBegin(GL_LINES); + glVertex2f(x+0.375, y+0.375); + glVertex2f(x+0.375, y+len+0.375); + glEnd(); + end + else + begin + glBegin(GL_QUADS); + glVertex2i(x, y); + glVertex2i(x, y+len); + glVertex2i(x+1, y+len); + glVertex2i(x+1, y); + glEnd(); + end; +end; + + +procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255); +begin + if not setupGLColor(r, g, b, a) then exit; + + glDisable(GL_TEXTURE_2D); + + glLineWidth(1); + glPointSize(1); + + if (not isScaled) then + begin + glBegin(GL_LINES); + glVertex2f(x1+0.375, y1+0.375); + glVertex2f(x2+0.375, y2+0.375); + glEnd(); + + if (x1 <> x2) or (y1 <> y2) then + begin + glBegin(GL_POINTS); + glVertex2f(x2+0.375, y2+0.375); + glEnd(); + end; + end + else + begin + glBegin(GL_LINES); + glVertex2i(x1, y1); + glVertex2i(x2, y2); + // draw last point + glVertex2i(x2, y2); + glVertex2i(x2+1, y2+1); + glEnd(); + end; + + glColor4f(1, 1, 1, 1); + glDisable(GL_BLEND); +end; + + +procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); +begin + if (w < 0) or (h < 0) then exit; + if not setupGLColor(r, g, b, a) then exit; + glDisable(GL_TEXTURE_2D); + glLineWidth(1); + glDisable(GL_LINE_SMOOTH); + glDisable(GL_POLYGON_SMOOTH); + if (w = 1) and (h = 1) then + begin + glBegin(GL_POINTS); + glVertex2f(x+0.375, y+0.375); + glEnd(); + end + else + begin + glBegin(GL_LINES); + glVertex2i(x, y); glVertex2i(x+w, y); // top + glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom + glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left + glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right + glEnd(); + end; + //glRect(x, y, x+w, y+h); + glColor4f(1, 1, 1, 1); + glDisable(GL_BLEND); +end; + + +procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); + procedure hline (x, y, len: Integer); + begin + if (len < 1) then exit; + glBegin(GL_QUADS); + glVertex2i(x, y); + glVertex2i(x+len, y); + glVertex2i(x+len, y+1); + glVertex2i(x, y+1); + glEnd(); + end; + + procedure vline (x, y, len: Integer); + begin + if (len < 1) then exit; + glBegin(GL_QUADS); + glVertex2i(x, y); + glVertex2i(x, y+len); + glVertex2i(x+1, y+len); + glVertex2i(x+1, y); + glEnd(); + end; + +var + scaled: Boolean; +begin + if (w < 0) or (h < 0) then exit; + if not setupGLColor(r, g, b, a) then exit; + glDisable(GL_TEXTURE_2D); + glLineWidth(1); + glDisable(GL_LINE_SMOOTH); + glDisable(GL_POLYGON_SMOOTH); + scaled := isScaled(); + if (w = 1) and (h = 1) then + begin + glBegin(GL_POINTS); + if scaled then glVertex2i(x, y) else glVertex2f(x+0.375, y+0.375); + glEnd(); + end + else + begin + if not scaled then + begin + glBegin(GL_LINES); + glVertex2i(x, y); glVertex2i(x+w, y); // top + glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom + glVertex2f(x+0.375, y+1); glVertex2f(x+0.375, y+h-1); // left + glVertex2f(x+w-1+0.375, y+1); glVertex2f(x+w-1+0.375, y+h-1); // right + glEnd(); + end + else + begin + hline(x, y, w); + hline(x, y+h-1, w); + vline(x, y+1, h-2); + vline(x+w-1, y+1, h-2); + end; + end; + //glRect(x, y, x+w, y+h); + glColor4f(1, 1, 1, 1); + glDisable(GL_BLEND); +end; + + +procedure darkenRect (x, y, w, h: Integer; a: Integer); +begin + if (w < 0) or (h < 0) then exit; + if (a < 0) then a := 0; + if (a >= 255) then exit; + glEnable(GL_BLEND); + glBlendFunc(GL_ZERO, GL_SRC_ALPHA); + glDisable(GL_LINE_SMOOTH); + glDisable(GL_POLYGON_SMOOTH); + glDisable(GL_TEXTURE_2D); + glColor4f(0.0, 0.0, 0.0, a/255.0); + glBegin(GL_QUADS); + glVertex2i(x, y); + glVertex2i(x+w, y); + glVertex2i(x+w, y+h); + glVertex2i(x, y+h); + glEnd(); + //glRect(x, y, x+w, y+h); + glColor4f(1, 1, 1, 1); + glDisable(GL_BLEND); + //glBlendEquation(GL_FUNC_ADD); +end; + + +procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255); +begin + if (w < 0) or (h < 0) then exit; + if not setupGLColor(r, g, b, a) then exit; + glDisable(GL_LINE_SMOOTH); + glDisable(GL_POLYGON_SMOOTH); + glDisable(GL_TEXTURE_2D); + glBegin(GL_QUADS); + glVertex2f(x, y); + glVertex2f(x+w, y); + glVertex2f(x+w, y+h); + glVertex2f(x, y+h); + glEnd(); + glColor4f(1, 1, 1, 1); + glDisable(GL_BLEND); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (font6texid = 0) then createFonts(); + drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false); + result := Length(s)*6; +end; + +function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (font8texid = 0) then createFonts(); + drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false); + result := Length(s)*8; +end; + +function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (prfont6texid = 0) then createFonts(); + result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true); +end; + +function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (prfont8texid = 0) then createFonts(); + result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// x-centered at `x` +function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (font6texid = 0) then createFonts(); + x -= Length(s)*6 div 2; + drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false); + result := Length(s)*6; +end; + +function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (font8texid = 0) then createFonts(); + x -= Length(s)*8 div 2; + drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false); + result := Length(s)*8; +end; + +function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (prfont6texid = 0) then createFonts(); + x -= textWidth6(s) div 2; + result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true); +end; + +function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer; +begin + if (prfont8texid = 0) then createFonts(); + x -= textWidth8(s) div 2; + result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure oglRestoreMode (doClear: Boolean); +begin + oglSetup2D(gScrWidth, gScrHeight); + glScissor(0, 0, gScrWidth, gScrHeight); + + glBindTexture(GL_TEXTURE_2D, 0); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + glDisable(GL_STENCIL_TEST); + glDisable(GL_SCISSOR_TEST); + glDisable(GL_LIGHTING); + glDisable(GL_DEPTH_TEST); + glDisable(GL_CULL_FACE); + glDisable(GL_LINE_SMOOTH); + glDisable(GL_POINT_SMOOTH); + glLineWidth(1); + glPointSize(1); + glColor4f(1, 1, 1, 1); + + if doClear then + begin + glClearColor(0, 0, 0, 0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_ACCUM_BUFFER_BIT or GL_STENCIL_BUFFER_BIT); + end; + + // scale everything + glMatrixMode(GL_MODELVIEW); + glLoadIdentity(); + //glScalef(4, 4, 1); +end; + + +procedure onWinFocus (); begin end; + +procedure onWinBlur (); begin resetKMState(true); end; + +procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end; + +procedure onPostRender (); begin oglRestoreMode(false); oglDrawCursor(); end; + +procedure onInit (); +begin + oglSetup2D(gScrWidth, gScrHeight); + + createCursorTexture(); + createFonts(); +end; + +procedure onDeinit (); +begin + resetKMState(false); + if (curtexid <> 0) then glDeleteTextures(1, @curtexid); + curtexid := 0; + deleteFonts(); + curButState := 0; + curModState := 0; + curMsX := 0; + curMsY := 0; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +begin + evSDLCB := onSDLEvent; + winFocusCB := onWinFocus; + winBlurCB := onWinBlur; + prerenderFrameCB := onPreRender; + postrenderFrameCB := onPostRender; + oglInitCB := onInit; + oglDeinitCB := onDeinit; +end. diff --git a/src/gx/sdlcarcass.pas b/src/gx/sdlcarcass.pas new file mode 100644 index 0000000..29c1c3f --- /dev/null +++ b/src/gx/sdlcarcass.pas @@ -0,0 +1,57 @@ +(* Copyright (C) DooM 2D:Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} +unit sdlcarcass; + +interface + +uses + SDL2; + + +// ////////////////////////////////////////////////////////////////////////// // +// event handlers +var + evSDLCB: function (var ev: TSDL_Event): Boolean = nil; + winFocusCB: procedure () = nil; + winBlurCB: procedure () = nil; + //buildFrameCB: procedure () = nil; + //renderFrameCB: procedure () = nil; // no need to call `glSwap()` here + prerenderFrameCB: procedure () = nil; + postrenderFrameCB: procedure () = nil; + oglInitCB: procedure () = nil; + oglDeinitCB: procedure () = nil; + + +function getScrWdt (): Integer; inline; +function getScrHgt (): Integer; inline; + +property + gScrWidth: Integer read getScrWdt; + gScrHeight: Integer read getScrHgt; + + +implementation + +uses + g_options; + + +function getScrWdt (): Integer; inline; begin result := gScreenWidth; end; +function getScrHgt (): Integer; inline; begin result := gScreenHeight; end; + + +end. -- 2.29.2