Category : Files from Magazines
Archive : DBMS0591.ZIP
Filename : LIEF1.MAY
Output of file : LIEF1.MAY contained in archive : DBMS0591.ZIP
Date: February 1991
Purpose: Demonstrate 5.0 virtual screen trickery with
BEGINPAINT() and ENDPAINT()
Caveat: These two functions are undocumented, and are
therefore subject to change at any time without
a moment's notice.
Compile with: Clipper virtual /n/w*/
#include "box.ch"
#include "inkey.ch"
#include "fileio.ch"
#translate drawbox(
setcolor(
#define FLICKER .F.
#define NOFLICKER .T.
function main_stub
Blinkey()
Curtains()
inkey(5)
Movement(FLICKER)
Movement(NOFLICKER)
return nil
/* Function: BLINKEY()
Purpose: Flashing alternate screens
to drive you crazy*/
function blinkey
local x, screens := {}
beginpaint()
setcursor(0)
drawbox('w/b', 0, 0, maxrow(), maxcol(), '1')
drawbox('w/r', 5, 5, 17, 74, '2')
aadd(screens, savescreen(0, 0, maxrow(), maxcol()))
drawbox('w/r', 0, 0, maxrow(), maxcol(), '1')
drawbox('w/b', 5, 5, 17, 74, '2')
aadd(screens, savescreen(0, 0, maxrow(), maxcol()))
endpaint()
do while inkey(.2) = 0
x = if(x = 1, 2, 1)
beginpaint()
restscreen(0, 0, maxrow(), maxcol(), screens[x])
endpaint()
enddo
return nil
/* End Function BLINKEY() */
/* Function: CURTAINS()
Purpose: Demonstrate spreading curtains effect*/
function Curtains
local x
beginpaint()
setcursor(0)
drawbox('w/b', 0, 0, maxrow(), maxcol(), ' ')
drawbox('w/r', 5, 5, 19, 74, ' ')
drawbox('w/rb', 9, 15, 16, 64, ' ')
drawbox('n/bg', 11, 24, 14, 55, ' ')
@ 12, 32 say "The Killer App"
@ 13, 26 say "Copyright (c) 1991 Joe Blow"
save_drape('title.scr')
setcolor('w/n')
cls
endpaint()
inkey(0)
pull_drape('title.scr')
return nil
/* End Function CURTAINS() */
/* Function: PULL_DRAPE()
Purpose: Draw title screen from specified memory file
Excerpted from the Grumpfish Library*/
function Pull_Drape(cfile)
local nhandle, screen_ := {}, buffer, xx, yy, midpoint, ;
mwidth, mlength, oldcurs := setcursor(0), ndelay := 10
if file(cfile)
if ( nhandle := fopen(cfile, FO_READ) ) != -1
mwidth = ( maxrow() + 1 ) * 2
buffer = space(mwidth)
for xx = 1 to maxcol() + 1
fread(nhandle, @buffer, mwidth)
aadd(screen_, buffer)
next
fclose(nhandle)
midpoint = int((maxcol() + 1) / 2) + 1
for xx = midpoint to maxcol() + 1
restscreen(0, xx - 1, maxrow(), xx - 1, screen_[xx])
restscreen(0, maxcol() + 1 - xx, maxrow(), ;
maxcol() + 1 - xx, screen_[maxcol() + 2 - xx])
for yy = 1 to ndelay
next
next
endif
endif
setcursor(oldcurs)
return NIL
/* End Function Pull_Drape() */
/* Function: SAVE_DRAPE()
Purpose: Save title screen to specified memory file
Excerpted from the Grumpfish Library*/
function save_drape(cfile)
local buffer, nhandle := fcreate(cfile), xx, ret_val := .f.
if ferror() = 0
ret_val = .t.
for xx = 0 to maxcol()
buffer = savescreen(0, xx, maxrow(), xx)
if fwrite(nhandle, buffer) != ( maxrow() + 1) * 2
ret_val = .f.
exit
endif
next
fclose(nhandle)
endif
return ret_val
/* End Function SAVE_DRAPE() */
/* Function: MOVEMENT()
Purpose: Resize a box with the arrow keys */
function Movement(noflicker)
local t := 10, l := 10, b := 12, r := 69, x, oldscrn, key := 0
setcursor(0)
setcolor('w/b')
/* draw bogus backdrop to prove the point */
for x = 0 to maxrow()
@ x, 0 say replicate(chr(x), maxcol() + 1)
next
oldscrn = savescreen(0, 0, maxrow(), maxcol())
setcolor('n/bg')
@ t, l, b, r box 'Ä¿³ÙÄÀ³ '
/* first allow anchoring of top left corner */
do while key != K_ESC .and. key != K_ENTER
key = inkey(0)
do case
case key = K_LEFT .and. l > 0
l--
case key = K_RIGHT .and. l < r + 1
l++
case key = K_UP .and. t > 0
t--
case key = K_DOWN .and. t < b - 1
t++
endcase
if noflicker
beginpaint()
endif
restscreen(0, 0, maxrow(), maxcol(), oldscrn)
@ t, l, b, r box 'Ä¿³ÙÄÀ³ '
if noflicker
endpaint()
endif
enddo
key = 0
@ t, l, b, r box 'ÚÄ¿³ÄÀ³ '
/* now allow anchoring of bottom right corner */
do while key != K_ESC .and. key != K_ENTER
key = inkey(0)
do case
case key = K_LEFT .and. r > l + 1
r--
case key = K_RIGHT .and. r < maxcol()
r++
case key = K_UP .and. b > t + 1
b--
case key = K_DOWN .and. b < maxrow()
b++
endcase
if noflicker
beginpaint()
endif
restscreen(0, 0, maxrow(), maxcol(), oldscrn)
@ t, l, b, r box 'ÚÄ¿³ÄÀ³ '
if noflicker
endpaint()
endif
enddo
return nil
/* End Function MOVEMENT()
/************** End of Program VIRTUAL.PRG *************/
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/