Menu
▾
▴
[Pythianproject-cvsmail] CVS: Prototypes/Console Demo frmMain.dfm,1.1,1.2 frmMain.pas,1.1,1.2
|
From: Michael H. <mh...@us...> - 2000-10-26 17:08:17
|
Update of /cvsroot/pythianproject/Prototypes/Console Demo In directory slayer.i.sourceforge.net:/tmp/cvs-serv6734/Console Demo Modified Files: frmMain.dfm frmMain.pas Log Message: no message ***** Bogus filespec: Demo Index: frmMain.dfm =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/Console Demo/frmMain.dfm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 Binary files /tmp/cvsOh73DS and /tmp/cvs8KkOaB differ Index: frmMain.pas =================================================================== RCS file: /cvsroot/pythianproject/Prototypes/Console Demo/frmMain.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** frmMain.pas 2000/10/21 12:26:23 1.1 --- frmMain.pas 2000/10/26 17:08:15 1.2 *************** *** 19,24 **** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! Menus, ExtCtrls, GLPanel, OpenGL, glfd; type TMainForm = class(TForm) --- 19,32 ---- uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ! Menus, ExtCtrls, GLPanel, OpenGL, glfd, Trace; + const + CONSOLE_SHOWN = 3; + CONSOLE_HIDDEN = 0; + CONSOLE_SHOWING = 1; + CONSOLE_HIDING = 2; + + CONSOLE_START_POS = 3.0; + type TMainForm = class(TForm) *************** *** 34,37 **** --- 42,47 ---- procedure Exit1Click(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); + procedure FormResize(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } *************** *** 39,45 **** --- 49,62 ---- animSquare :integer; CubeEnabled :boolean; + consoleMode :byte; // 0 = hidden; 1 = showing; 2 = hiding; 3 = shown + consoleY :single; // top of console location for animation + strOverlay :TStringList; + textList :integer; procedure consoleInit; procedure consoleProcessKey(Key:Char); procedure consoleProcessCommand(cmd:string); + procedure consoleDraw; + + procedure DumpStrings(s:TStringList); public { Public declarations } *************** *** 67,70 **** --- 84,88 ---- begin // Redefine the viewing volume and viewport when the window size changes. + glClear(GL_COLOR_BUFFER_BIT); gldAspect := GLPanel.Width / GLPanel.Height; *************** *** 99,102 **** --- 117,122 ---- glfSetAnchorPoint(GLF_LEFT_UP); + strOverlay := TStringList.Create; + textList := glGenLists(1); consoleInit; end; *************** *** 191,215 **** glEnable(GL_BLEND); end; - - - { now draw an alpha quad to effectively "clear" the screen but still - leaving something showing } - glLoadIdentity; - glColor4f(0.6,0.6,0.6,0.99); - glTranslatef(0.0,0.0,-1.0); - glBegin(GL_QUADS); - glVertex2f(1.0,1.0); - glVertex2f(1.0,-1.0); - glVertex2f(-1.0,-1.0); - glVertex2f(-1.0,1.0); - glEnd; - glClear(GL_DEPTH_BUFFER_BIT); glLoadIdentity; ! glTranslatef(-1.0,1.0,-1.0); glScalef(0.04,0.04,0.04); ! glfConsoleDraw; except // ignore exceptions - the delphi IDE seems to screw up on my system :( --- 211,249 ---- glEnable(GL_BLEND); end; + // text glLoadIdentity; ! glDisable(GL_DEPTH_TEST); ! glTranslatef(-1.0,1.0,0); glScalef(0.04,0.04,0.04); + glCallList(textList); + glEnable(GL_DEPTH_TEST); + glLoadIdentity; ! { work the different modes } ! if ConsoleMode = CONSOLE_SHOWING then ! begin ! consoleDraw; ! consoleY := consoleY - 0.1; ! if consoleY <= 1.1 then ! begin ! consoleY := 1.0; ! ConsoleMode := CONSOLE_SHOWN; ! end; ! end else if ConsoleMode = CONSOLE_HIDING then ! begin ! consoleDraw; ! consoleY := consoleY + 0.1; ! if consoleY >= CONSOLE_START_POS then ! begin ! ConsoleMode := CONSOLE_HIDDEN; ! consoleY := CONSOLE_START_POS; ! end; ! end else if ConsoleMode = CONSOLE_SHOWN then ! begin ! glLoadIdentity; ! consoleDraw; ! end; except // ignore exceptions - the delphi IDE seems to screw up on my system :( *************** *** 229,237 **** procedure TMainForm.consoleProcessKey(Key: Char); begin ! // add this key to the console, unless it is a backspace key if Key = #8 {backspace} then begin ! glfConsoleBackspace(1); ! consoleCommandBuffer := Copy(consoleCommandbuffer,0,Length(consoleCommandBuffer)-1); end else if Key = #13 then --- 263,290 ---- procedure TMainForm.consoleProcessKey(Key: Char); begin ! // process hide/show key (`) ! if key = #96 then ! begin ! if ConsoleMode = CONSOLE_HIDDEN then ! ConsoleMode := CONSOLE_SHOWING ! else if ConsoleMode = CONSOLE_SHOWN then ! ConsoleMode := CONSOLE_HIDING ! else if ConsoleMode = CONSOLE_SHOWING then ! ConsoleMode := CONSOLE_HIDING ! else if ConsoleMode = CONSOLE_HIDING then ! ConsoleMode := CONSOLE_SHOWING; ! exit; ! end; ! ! // check that we're not hidden ! if consoleMode = CONSOLE_HIDDEN then exit; ! // if not then add this key to the console, unless it is a backspace key if Key = #8 {backspace} then begin ! if Length(ConsoleCommandBuffer) > 0 then ! begin ! glfConsoleBackspace(1); ! consoleCommandBuffer := Copy(consoleCommandbuffer,0,Length(consoleCommandBuffer)-1); ! end; end else if Key = #13 then *************** *** 253,264 **** --- 306,326 ---- begin consoleCommandBuffer := ''; + consoleMode := CONSOLE_SHOWING; + consoleY := CONSOLE_START_POS; glfSetConsoleParam( 45, 24); // this clears the console for 640x480 glfPrintString('Console Demo app v1.0'#13); glfPrintString('by Michael Hearn'#13); + glfPrintString('- Use the ` key to show/hide the console'#13); + glfPrintString('- Type help for command info'#13); glfPrintString('> '); end; procedure TMainForm.consoleProcessCommand(cmd: string); + var + fn :string; // filename for dump command + x,y:integer; + s:string; begin + TraceString(Copy(cmd,0,Pos(#32,cmd))); if (LowerCase(cmd) = 'help') or (cmd = '?') then begin *************** *** 267,270 **** --- 329,333 ---- glfPrintString(' - help/?: displays this text'#13); glfPrintString(' - cube on/off: changes the background cube'#13); + glfPrintString(' - dump "filename": writes filename to the screen'#13); glfPrintString(' - exit: quits the demo'#13); end else if (LowerCase(cmd) = 'cube on') then *************** *** 276,283 **** --- 339,405 ---- CubeEnabled := false; glfPrintString('Cube OFF'#13); + end else if (LowerCase(cmd) = 'cube') then + begin + if CubeEnabled then glfPrintString('Cube is ON') else glfPrintString('Cube is OFF'); + end else if (LowerCase(cmd) = 'dump') then + begin + glNewList(textList,GL_COMPILE); + for y := 0 to 30 do + begin + s := ''; + for x := 0 to 40 do + s := s + Chr(Trunc(Random(Ord('Z') - Ord('A')) + Ord('A'))); + glfDrawSolidString(s); + glTranslatef(0,-2,0); + end; + glEndList; end else if (LowerCase(cmd) = 'exit') then begin Close; end; + end; + + procedure TMainForm.FormResize(Sender: TObject); + begin + SetProjection(Sender); + end; + + procedure TMainForm.consoleDraw; + begin + { now draw an alpha quad to effectively "clear" the screen but still + leaving something showing } + glColor4f(0.6,0.6,0.6,0.99); + glTranslatef(0.0,consoleY-1,-1.0); + glBegin(GL_QUADS); + glVertex2f(1.0,1.0); + glVertex2f(1.0,-1.0); + glVertex2f(-1.0,-1.0); + glVertex2f(-1.0,1.0); + glEnd; + + + glClear(GL_DEPTH_BUFFER_BIT); + glLoadIdentity; + glTranslatef(-1.0,consoleY,-1.0); + glScalef(0.04,0.04,0.04); + + glfConsoleDraw; + end; + + procedure TMainForm.DumpStrings(s: TStringList); + var a:integer; + begin + // dumps the contents of s to the glf console + for a := 0 to s.Count-1 do + begin + glfDrawSolidString(s.Strings[a]); + glTranslatef(0.0,-2,0.0); + end; + end; + + procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); + begin + strOverlay.free; + glDeleteLists(textList,1); end; |
