'=========================================================================== ' Subject: GET/PUT IN TEXT Date: 04-10-96 (11:31) ' Author: Carl Gorringe Code: QB, QBasic, PDS ' Origin: FidoNet QUIK_BAS Echo Packet: TEXT.ABC '=========================================================================== '>Is it possible to wipe from one screen to another in text mode? (Looks like '>one screen is raised or pulled off to the side revealing another screen '>underneath.) 'Following is a program that will allow you to GET any portion of the 'Text screen into an array, and then PUT it back anywhere on screen. If 'the image goes off the edge, then it is simply clipped, so I believe you 'can get the effect you are looking for by using them. Enjoy! '--- Carl Gorringe --- '---------------------------------- ' GETPUT.BAS - (c) Carl Gorringe '---------------------------------- ' Released to the public domain ' You may use this or modify it any way you want, just remember ' to give me credit if you use it in your programs. '---- Must Keep All of the Following! ---- DECLARE SUB TextGetPutLoad () DECLARE SUB TextGetPut (Xlen%, Ylen%, SorcSeg%, SorcOff%, SorcSkip%, DestSeg%, DestOff%, DestSkip%) DECLARE SUB TextGet (X1%, Y1%, X2%, Y2%, Image%()) DECLARE SUB TextPut (X1%, Y1%, Image%()) COMMON SHARED TextGetPutRoutine%() DIM SHARED TextGetPutRoutine%(30) CALL TextGetPutLoad '--------- Begin Program ---------- ' Put Whatever you want here. ' Just remember that the GET/PUT routines ONLY work for ' SCREEN 0; WIDTH 80,25; and Text Page 0 ' You can switch to other modes, just don't call these routines in them. END '---------- End Program ----------- SUB TextGet (X1%, Y1%, X2%, Y2%, Image%()) ' ::: (c) Carl Gorringe 6/13/93 ::: << v2.1 >> '-------------------------------------------------------- ' This gets the text region from (X1%,Y1%) to (X2%,Y2%) ' and stores it in Image%(). Make sure Image%() is a ' DYNAMIC array because this SUB will REDIM it. ' Coordinates start at (1,1) for the upper-left corner. '-------------------------------------------------------- ScrWidth% = 80 ScrLength% = 25 IF X1% < 1 OR X1% > X2% OR Y1% < 1 OR Y1% > Y2% THEN EXIT SUB Num% = (X2% - X1% + 1) * (Y2% - Y1% + 1) + 1 REDIM Image%(Num%) Image%(0) = X2% - X1% + 1 Image%(1) = Y2% - Y1% + 1 '<*>--------- Machine Language Varibles ----------<*> IF X2% > ScrWidth% THEN TableSkip% = (X2% - ScrWidth%) * 2 X2% = ScrWidth% ELSE TableSkip% = 0 END IF IF Y2% > ScrLength% THEN Y2% = ScrLength% END IF Xcount% = X2% - X1% + 1: Ycount% = Y2% - Y1% + 1 ScrStart% = (ScrWidth% * (Y1% - 1) + (X1% - 1)) * 2 NextLine% = (ScrWidth% * 2) - (Xcount% * 2) PageSegment% = &HB800 '-- Screen 0, Page 0 -- TableSegment% = VARSEG(Image%(0)) TableOffset% = VARPTR(Image%(0)) + 4 CALL TextGetPut(Xcount%, Ycount%, PageSegment%, ScrStart%, NextLine%, TableSegment%, TableOffset%, TableSkip%) END SUB SUB TextGetPut (Xlen%, Ylen%, SorcSeg%, SorcOff%, SorcSkip%, DestSeg%, DestOff%, DestSkip%) ' ::: (c) Carl Gorringe 6/13/93 ::: << v1.3 >> '-------------------------------------------------------- ' This Should NOT be Used by itself! ' It should ONLY be used within TextGet() and TextPut()! '-------------------------------------------------------- IF TextGetPutRoutine%(0) <> &HBB06 THEN CALL TextGetPutLoad END IF '<*>------- Pass Machine Language Arguments -------<*> Low% = LBOUND(TextGetPutRoutine%) DEF SEG = VARSEG(TextGetPutRoutine%(Low%)) '--Set Segment-- P% = VARPTR(TextGetPutRoutine%(Low%)) '--Set Offset-- POKE (P% + &H2), ASC(LEFT$(MKI$(SorcSeg%), 1)) POKE (P% + &H3), ASC(RIGHT$(MKI$(SorcSeg%), 1)) POKE (P% + &H5), ASC(LEFT$(MKI$(DestSeg%), 1)) POKE (P% + &H6), ASC(RIGHT$(MKI$(DestSeg%), 1)) POKE (P% + &H8), ASC(LEFT$(MKI$(DestOff%), 1)) POKE (P% + &H9), ASC(RIGHT$(MKI$(DestOff%), 1)) POKE (P% + &HB), ASC(LEFT$(MKI$(SorcOff%), 1)) POKE (P% + &HC), ASC(RIGHT$(MKI$(SorcOff%), 1)) POKE (P% + &HE), ASC(LEFT$(MKI$(Ylen%), 1)) POKE (P% + &H10), ASC(LEFT$(MKI$(Xlen%), 1)) POKE (P% + &H26), ASC(LEFT$(MKI$(SorcSkip%), 1)) POKE (P% + &H27), ASC(RIGHT$(MKI$(SorcSkip%), 1)) POKE (P% + &H2B), ASC(LEFT$(MKI$(DestSkip%), 1)) POKE (P% + &H2C), ASC(RIGHT$(MKI$(DestSkip%), 1)) '<*>--------- Run Machine Language Routine ---------<*> CALL ABSOLUTE(P%) DEF SEG END SUB SUB TextGetPutLoad ' ::: (c) Carl Gorringe 6/13/93 ::: << v1.0 >> '-------------------------------------------------------- ' This only needs to be called once in the beginning of the ' program to store the Assembly language code into the ' global array TextGetPutRoutine%(). '-------------------------------------------------------- Low% = LBOUND(TextGetPutRoutine%) DEF SEG = VARSEG(TextGetPutRoutine%(Low%)) '--Set Segment-- P% = VARPTR(TextGetPutRoutine%(Low%)) '--Set Offset-- '<*>------ Start Assembly Language Code ------<*> ' --- 41 bytes long --- POKE (P% + &H0), &H6 ' Push ES POKE (P% + &H1), &HBB ' Mov BX , ???? POKE (P% + &H4), &HBA ' Mov DX , ???? POKE (P% + &H7), &HBF ' Mov DI , ???? POKE (P% + &HA), &HBE ' Mov SI , ???? POKE (P% + &HD), &HB5 ' Mov CH , ?? POKE (P% + &HF), &HB1 ' Mov CL , ?? POKE (P% + &H11), &H8E: POKE (P% + &H12), &HC3 ' Mov ES , BX POKE (P% + &H13), &H26 ' ES: POKE (P% + &H14), &H8B: POKE (P% + &H15), &H4 ' Mov AX ,[SI] POKE (P% + &H16), &H8E: POKE (P% + &H17), &HC2 ' Mov ES , DX POKE (P% + &H18), &H26 ' ES: POKE (P% + &H19), &H89: POKE (P% + &H1A), &H5 ' Mov [DI], AX POKE (P% + &H1B), &H83: POKE (P% + &H1C), &HC6 ' Add SI ,+02 POKE (P% + &H1D), &H2 POKE (P% + &H1E), &H83: POKE (P% + &H1F), &HC7 ' Add DI ,+02 POKE (P% + &H20), &H2 POKE (P% + &H21), &HFE: POKE (P% + &H22), &HC9 ' Dec CL POKE (P% + &H23), &H75: POKE (P% + &H24), &HEC ' Jnz &H11 POKE (P% + &H25), &HB8 ' Mov AX , ???? POKE (P% + &H28), &H1: POKE (P% + &H29), &HC6 ' Add SI , AX POKE (P% + &H2A), &HB8 ' Mov AX , ???? POKE (P% + &H2D), &H1: POKE (P% + &H2E), &HC7 ' Add DI , AX POKE (P% + &H2F), &HFE: POKE (P% + &H30), &HCD ' Dec CH POKE (P% + &H31), &H75: POKE (P% + &H32), &HDC ' Jnz &HF POKE (P% + &H33), &H7 ' Pop ES POKE (P% + &H34), &HCB ' Retf '-------------------------------- DEF SEG END SUB SUB TextPut (X1%, Y1%, Image%()) ' ::: (c) Carl Gorringe 6/13/93 ::: << v2.1 >> '-------------------------------------------------------- ' This puts the image stored in Image%() back to the screen ' with the upper-left corner of the image at (X1%,Y1%). ' Coordinates start at (1,1) for the upper-left corner of ' the screen. If the image goes outside of bounds then it ' will be automatically clipped. '-------------------------------------------------------- ScrWidth% = 80 ScrLength% = 25 X2% = Image%(0) - 1 + X1% Y2% = Image%(1) - 1 + Y1% IF X1% < 1 OR X1% > X2% OR Y1% < 1 OR Y1% > Y2% THEN EXIT SUB Num% = (X2% - X1% + 1) * (Y2% - Y1% + 1) + 1 '<*>--------- Machine Language Varibles ----------<*> IF X2% > ScrWidth% THEN TableSkip% = (X2% - ScrWidth%) * 2 X2% = ScrWidth% ELSE TableSkip% = 0 END IF IF Y2% > ScrLength% THEN Y2% = ScrLength% END IF Xcount% = X2% - X1% + 1: Ycount% = Y2% - Y1% + 1 ScrStart% = (ScrWidth% * (Y1% - 1) + (X1% - 1)) * 2 NextLine% = (ScrWidth% * 2) - (Xcount% * 2) PageSegment% = &HB800 '-- Screen 0, Page 0 -- TableSegment% = VARSEG(Image%(0)) TableOffset% = VARPTR(Image%(0)) + 4 CALL TextGetPut(Xcount%, Ycount%, TableSegment%, TableOffset%, TableSkip%, PageSegment%, ScrStart%, NextLine%) END SUB