8bitfiles.net/archives/archives.tar/archives/genie-commodore-file-library/MRFiles/GS3DVPAK.ARC/MISCSOURCE

GEOS ConVerT | 2019-04-13 | 21.7 KB | 517 lines

%MiscSource
PRG formatted GEOS file V1.0
CONVERTED WITH GEOSHELL V2.2
Write Image V2.1
geoWrite    V2.1
@MISCELLANEOUS SOURCE CODE
This is a table of contents of the sample source code contained in this file. Feel free to make use of the code contained here for use in your own commands. This helps save time, instead of trying to invent something that has already been done for you. Just use GeoWrite to cut and paste any of these examples into your own source code.
BLANKING AND RESTORING THE 40 COLUMN SCREEN    2
    RstrWindow    2
    BlnkWMessage    3
    BlnkNMessage    4
SENDING DATA TO THE PRINTER    5
    InitPrinter    6
    ByteToPrinter    7
COLORING THE 80 COLUMN SCREEN    8
    Coloring Icons (example)    8
    CloseCommand (example)    8
    icnClrScrap    9
    icnClrCombos    9
    DoColorFrame    10
GIVE geoSHELL COLOR IN 40 COLUMNS    11
    Color40    11
    Add40R0 (used with Color40)    12
SEARCHING THE COMMAND BUFFER    13
    FindSkip    13
    IncR0    14
;here is the code that will call the routines to blank the 40 column
;screen and restore them after your command finishes it's task.
;This method puts a messag
;here is the code that will call the routines to blank the 40 column
;screen and restore them after your command finishes it's task.
;This method puts a message on the bottom of the 40 column screen and
;also deals with proper handling if the routine is run on an 80 column 128.
;You will be able to use memory from $a000 to $bdff.
;If you need the additional 320 bytes that the message on the bottom uses,
;then use BlnkNMessage in place of BlnkWMessage. BlnkNMessage can be found
;on the following page. Be sure to call RstrWindow before exiting your command.
;Also, test your command for anything that might happen while the screen is
;blanked. You must be able to call RstrWindow to get the window back on the
;screen for the user.
    ...        ;any code ahead of this...
    jsr    BlnkWMessage    ;blank the screen with a message
            ;at the bottom.
    jsr    DoYourThing    ;this calls your own code.
    jsr    RstrWindow    ;put the geoSHELL window back.
    ...        ;any more additional code....
RstrWindow:
    jsr    StartMouseMode    ;turn the mouse back on.
    bit    screenmode    ;is this 80 column mode?
    bmi    50$    ;branch if so. (80 columns didn't blank)
    jsr    ClearScreen    ;clear the screen.
    jsr    ReDoWindow    ;redraw the window and it's contents.
            ;this is all taking place while the
            ;screen is still blanked, until we
    jsr    FixColors    ;put the color back on the screen.
    jmp    R_Icons    ;do this because the icon gets killed.
;this routine blanks the 40 column screen and displays a message at the
;bottom. If in 80 column mode, it will put the same message in the
;geoSHELL window since the screen does not have to be blanked. The message
;will also be placed in the 40 column window in addition to the bottom of
;the screen.
BlnkWMessage:
    jsr    ClearMouseMode    ;shut the mouse off for now.
    LoadW    r0,#prgrsText    ;point at our message.
    lda    #(IN_ONE|TR_CR)
    jsr    OtherMessage    ;put it on 40 or 80 columns.
    bit    screenmode    ;now check for 80 columns.
    bmi    20$    ;branch if so and skip the rest.
    LoadW    r0,#(24*40)    ;blank only the upper 24 card rows.
    LoadW    r1,#COLOR_MATRIX
    lda    screencolors    ;get the current screencolors.
    and    #%00001111    ;put the background color into
    sta    r2L
    asl    a
    asl    a
    asl    a
    asl    a
    ora    r2L    ;the foreground also.
    sta    r2L
    jsr    FillRam    ;and color the screen.
    PushB    windowBottom    ;make sure that PutString can
    LoadB    windowBottom,#199 ;get down to the bottom of the screen.
    LoadW    r0,#prgrs40Text    ;point r0 for PutString.
    jsr    PutString    ;use GEOS to print this string.
    PopB    windowBottom    ;restore this.
    rts        ;and return.
prgrs40Text:
    .byte    GOTOXY
    .word    24    ;start printing at the 24th pixel.
            ;adjust this for the length of
            ;your message.
    .byte    198
;put your message here, but leave a leading and trailing space in
;the message so that the background pattern doesn't brush up against
;the message, for a better appearance.
prgrsText:
    .byte    " Put Your Message Here... ",0
;this routine blanks the 40 column screen and allows you to use the
;entire foreground screen memory area since this routine does not
;put a message at the bottom of the screen.
;80 column mode is still dealt with properly here. The message in this
;routine will only appear in the window on both the 40 and 80 column screens
;and not at the bottom of the screen like it does with BlnkWMessage.
BlnkNMessage:
    jsr    ClearMouseMode    ;shut the mouse off for now.
    LoadW    r0,#prgrsText    ;point at our message.
    lda    #(IN_ONE|TR_CR)
    jsr    OtherMessage    ;put it on 40 or 80 columns.
    bit    screenmode    ;now check for 80 columns.
    bmi    20$    ;branch if so and skip the rest.
    LoadW    r0,#(25*40)    ;blank the entire screen.
    LoadW    r1,#COLOR_MATRIX
    lda    screencolors    ;get the current screencolors.
    and    #%00001111    ;put the background color into
    sta    r2L
    asl    a
    asl    a
    asl    a
    asl    a
    ora    r2L    ;the foreground also.
    sta    r2L
    jsr    FillRam    ;and color the screen.
    rts        ;and return.
prgrsText:
    .byte    "Put Your Message Here...",0
;These routines will allow you to send data to a printer whether it
;be connected through the serial port or the user port with a geoCable.
;Just let InitPrinter and ByteToPrinter know which device y
;These routines will allow you to send data to a printer whether it
;be connected through the serial port or the user port with a geoCable.
;Just let InitPrinter and ByteToPrinter know which device you want data
;sent to. This example uses a variable printDest to identify that. If
;bit 7 is set, data goes to serial, bit 6 set goes to geoCable. If both
;bits are set, data goes to both. The following example will load printDest
;from a parameter the user supplies and proceed to do it's thing.
;One thing to keep in mind with using the printer: If you are sending text
;to a printer and also displaying the same text on the screen using
;geoSHELL routines, the user will get double copies of the data on the
;printer if he is using the @p or @g commands. Normally, your use of the
;printer won't involve sending the same text to the screen anyway.
    ...        ;code leading up to this.
    lda    ParamTable+0
    cmp    #'p'
    beq    10$
    cmp    #'g'
    beq    20$
    jmp    MissgFilename    ;display a bad parameter.
    lda    #%10000000
    .byte    $2c
    lda    #%01000000
    sta    printDest
    ...        ;whatever else code you might have.
    jsr    InitPrinter    ;make sure the printer is there.
    bit    goodflag    ;if the printer is not available
            ;you can deal with it however you wish.
            ;in this case we will just exit.
    bmi    30$    ;branch if printer is ready.
    jmp    NoMoreCmds    ;you might display an error message
            ;before this exit if needed.
    jsr    InitForIO
    ...        ;whatever routines you need to load
    ...        ;the accumulator will go here.
    ...        ;usually from a buffer.
    jsr    ByteToPrinter    ;send the byte in the accumulator
            ;to the printer.
    ...        ;now you either go back and do
    ...        ;some more or just end your command.
    jsr    Unlsn    ;in case we're using the serial printer.
    jsr    DoneWithIO
UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU
;this routine checks to make sure that the printer/s is/are connected and
;ready to accept data. printDest identifies which port/s to find the
;printer/s at. After this routine is called, if a serial printer is being
;used, then it will be left in 'listen' mode on the serial bus. Before any
;disk access can occur, you must call the kernal routine 'Unlsn'. Then
;before further access to the printer you will have to call InitPrinter again.
InitPrinter:
    bit    printDest    ;where's the printer?
    bmi    10$    ;branch if serial.
    bvs    50$    ;branch if geoCable.
    bpl    20$    ;branch if neither.
    lda    curPrinter    ;printer device # set by 'pconf'.
    jsr    SetDevice
    jsr    InitForIO    ;pop out of GEOS.
    LoadB    STATUS,#0    ;clear STATUS.
    lda    curPrinter
    jsr    Listen    ;tell the printer to listen.
    lda    curSecond    ;secondary address set by 'pconf'.
    ora    #$60
    jsr    Second    ;send a command to the printer.
    lda    STATUS    ;did the printer respond?
    beq    30$    ;branch if so.
    jsr    Unlsn    ;tell the printer to stop listening.
            ;(what printer? there wasn't any)
    jsr    DoneWithIO    ;pop back into GEOS.
    jmp    nogood
    jsr    DoneWithIO    ;pop back into GEOS.
            ;serial printer is still in
            ;listen mode.
    bit    printDest    ;are we also doing the geoCable?
    bvc    80$    ;branch if not.
    jsr    InitForIO    ;pop out of GEOS.
    jsr    Open_GC_Channel    ;check for a printer on the geoCable.
    txa        ;save it for a second.
    beq    60$    ;branch if printer responded.
    jsr    Unlsn    ;otherwise unlisten the serial bus
            ;in case the serial printer is also set.
    jsr    DoneWithIO    ;pop back into GEOS.
    pla        ;well?
    bne    20$    ;branch if no printer.
    jmp    yesgood
printDest:
    .block    1
;this routine sends a byte to the printer/s.
;load the accumulator with the byte to send
;this routine sends a byte to the printer/s.
;load the accumulator with the byte to send.
;printDest identifies which port/s to find the printer/s at.
;InitForIO must be called before this routine.
;InitPrinter must be called before this routine.
;call the kernal routine Unlsn after sending the last byte if a serial
;printer is being used.
ByteToPrinter:
    sta    byteToPrint
    bit    printDest    ;where's the printer?
    bmi    20$    ;branch if serial.
    bvs    50$    ;branch if geoCable.
    jsr    Ciout
    bit    printDest
    bvc    10$
    lda    byteToPrint
    jmp    Send_GC_Byte
byteToPrint:
    .block    1
he serial printer.
    jsr    DoneWithIO
;this example will clear the 80 column color mode screen and
;color some icons that you will place on the screen.
;the current color bytes that are being altered will be saved and
;then restored upon exit.
;Modify this routine and use it as desired.
    bit    screenmode    ;is this a 128?
    bmi    20$    ;branch if so.
    LoadW    r0,#colrOnlyText    ;tell the user this command is
    lda    #(IN_TWO|TR_CR)    ;for 128 color mode only.
    jsr    OtherMessage
    jmp    NoMoreCmds    ;and exit.
    bit    videomode    ;are we in color mode?
    bpl    10$    ;branch if not.
    MoveB    backcolor,sbackcolor ;save the default background color.
    MoveB    textcolor,stextcolor ;save the default foreground color.
    MoveB    brdrcolor,sbrdrcolor ;save the default border color.
    MoveB    clr80pattern,sclr80pattern ;save the default pattern.
    LoadB    backcolor,#WHITE80 ;set background to white.
    LoadB    textcolor,#BLACK80 ;set the foreground color to black.
    LoadB    clr80pattern,#0    ;set background pattern #0
    jsr    ClearScreen    ;clear the screen.
    LoadB    brdrcolor,#WHITE80 ;set the border color
    jsr    SetBrdrColor    ;to white.
    ...        ;through this section, use BitmapUp
    ...        ;to put some icons on the screen
    LoadW    r0,#icnClrScrap    ;call ColorScreen to color the icons.
    LoadW    r1,#icnClrCombos
    jmp    ColorScreen
    ...        ;now you can point GEOS at your own
    ...        ;icon table and rts to mainloop
;one of the icons could call a routine to exit your command such as follows:
CloseCommand:
    MoveB    sbackcolor,backcolor ;restore the default background color.
    MoveB    stextcolor,textcolor ;restore the default foreground color.
    MoveB    sbrdrcolor,brdrcolor ;restore the default border color.
    MoveB    sclr80pattern,clr80pattern ;restore the default pattern.
    jsr    ClearScreen    ;clear the screen.
    jsr    ReDoWindow    ;put geoSHELL just like it was.
    jmp    ExitCommand    ;and exit.
colrOnlyText:
    .byte    "Command Only Works In 128 Color!",0
sbackcolor:
    .block 1
stextcolor:
    .block 1
sbrdrcolor:
    .block 1
sclr80pattern:
    .block 1
;this Color Scrap will color 8 ico
;this Color Scrap will color 8 icons that are placed in two rows of 4
;similar to the way they are arranged on the Desktop. This only colors the
;areas of the screen where the icons should be. You use BitmapUp to
;put the icons in place.
;To use this Color Scrap, point r0 at icnClrScrap and r1 at IcnClrCombos
;and then call ColorScreen.
;To understand this Color Scrap, each icon is 6 cards wide and 3 cards tall.
;The upper left corner of icon #1 is at row 10, column 10. There are 4
;icons on this row. There is 6 cards separating each icon. The next row of
;four icons is directly below the first row of icons and is at row 16.
;Each icon is given a different color.
;The third row of bytes in this example is repeated 3 times. It begins
;at column zero and skips over to column 10 without doing any coloring.
;Then, 6 cards are colored with color #0 from the color table. 6 more cards
;are skipped and 6 are colored with color #1. This goes on until the
;rightmost icon gets it's coloring. Then 28 bytes are skipped to put the
;pointer at the start of the next row. Now this will repeat to color
;the second card row of each of the top icons. A similar thing happens
;for the second row of icons later on as you can see.
;Modify this for your own use.
icnClrScrap:
    .byte    10,0    ;row 10, column 0
    .byte    3,8    ;repeat 8 commands 3 times.
    .byte    10,255,6,0,6,255,6,1,6,255,6,2,6,255,6,3,28,255
    .byte    255    ;a new position command.
    .byte    16,0    ;row 16, column 0
    .byte    3,8    ;repeat 8 commands 3 times.
    .byte    10,255,6,4,6,255,6,5,6,255,6,6,6,255,6,7,28,255
    .byte        ;end of table.
icnClrCombos:
    .byte    (DK80BLUE<<4)|LT80CYAN ;dk blue foregrnd,light cyan backgrnd.
    .byte    (BLACK80<<4)|LT80YELLOW
    .byte    (DK80PURPLE<<4)|WHITE80
    .byte    (DK80RED<<4)|LT80RED
    .byte    (LT80GREY<<4)|BLACK80
    .byte    (DK80BLUE<<4)|LT80GREY
    .byte    (DK80GREEN<<4)|BLACK80
    .byte    (WHITE80<<4)|DK80RED
;this example will draw a framed rectangle and then color the
;frame of the rectangle and the space
;this example will draw a framed rectangle and then color the
;frame of the rectangle and the space within the rectangle.
;This particular rectangle will be drawn exactly where the
;geoSHELL window resides. It will be given a black frame, while the space
;inside the rectangle will have a white background with a dark blue
;foreground. This example only works in 80 column color mode.
;Modify this for your own use.
DoColorFrame:
    jsr    ClearScreen    ;clear the screen with default
            ;foreground and background colors
            ;and background pattern.
    lda    #0    ;use pattern number #0.
    jsr    SetPattern
    jsr    i_Rectangle    ;draw the rectangle.
    .byte    32,167
    .word    16,607
    jsr    i_FrameRectangle    ;and put a frame around it.
    .byte    32,167
    .word    16,607
    .byte    255
    LoadW    r0,#frameScrap
    LoadW    r1,#frameColors
    jmp    ColorScreen
frameScrap:
    .byte    4,2    ;row 4, column 2
    .byte    1,1    ;repeat 1 command set once.
    .byte    74,0    ;color 74 cards, the top of the rectangle.
    .byte    15,5    ;repeate 5 command sets 15 times.
    .byte    2,255,1,0,72,1,1,0,4,255
            ;color the next 15 rows of the
            ;rectangle.
    .byte    1,2    ;repeat 2 commands sets once.
    .byte    2,255,74,0    ;color the bottom of the rectangle.
    .byte    0
;use two different color combinations with this rectangle.
frameColors:
    .byte    (BLACK80<<4)|WHITE80
    .byte    (DK80BLUE<<4)|WHITE80
;here is a routine that would give color to geoSHELL when in 40 column mode.
;Just change the equates here to whatever you like.
;geoSHELL has a built-in
;here is a routine that would give color to geoSHELL when in 40 column mode.
;Just change the equates here to whatever you like.
;geoSHELL has a built-in routine for doing this same thing in 80
;column mode. The routine is called ColorScreen. It is much simpler
;to create a Color Scrap for that routine to use. For the 40 column
;screen, though, geoSHELL has no coloring routines except for FixColors
;which restores the original screen colors (one foreground and one
;background color).
BACKBACK    = LTBLUE    ;background color in background area.
BACKFORE    = BLUE    ;foreground color in background area.
SHELLCLR    = RED    ;frame color of geoSHELL.
PADCLR    = WHITE    ;pad color of geoSHELL.
TEXTCLR    = BLACK    ;text color in pad area.
Color40:
    LoadW    r0,#COLOR_MATRIX    ;start of 40 column color area.
    ldy    #0
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y    ;color the upper four rows of screen.
    cpy    #160
    bne    10$
    AddVW    #160,r0    ;increment r0 to point at the top row
            ;of the shell frame.
    ldx    #3    ;do this segment three times.
    ldy    #0
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y    ;color empty space at left of frame.
    lda    #((SHELLCLR<<4)|PADCLR)
    sta    (r0),y    ;color the top of the frame.
    cpy    #38
    bne    20$
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y    ;color the two empty spaces at the right
            ;of the frame.
    sta    (r0),y
    jsr    Add40R0
    bne    15$
    ldx    #12    ;now do 14 rows of the screen in the
            ;pad area.
    ldy    #0
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y    ;the empty space at the left.
    lda    #((SHELLCLR<<4)|PADCLR)
    sta    (r0),y    ;one card on the left border of frame.
    lda    #((TEXTCLR<<4)|PADCLR)
    lda    #((TEXTCLR<<4)|PADCLR)
    sta    (r0),y    ;color 37 cards in the pad.
    cpy    #37
    bne    50$
    lda    #((SHELLCLR<<4)|PADCLR)
    sta    (r0),y    ;color the border at the right side.
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y    ;color the two empty spaces at the right.
    sta    (r0),y
    jsr    Add40R0    ;point at the next row down.
    dex        ;count down from 12.
    bne    40$    ;branch if more to do.
    ldx    #2
    ldy    #0    ;now we do the bottom of the frame.
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y
    lda    #((SHELLCLR<<4)|PADCLR)
    sta    (r0),y
    cpy    #38
    bne    60$
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y
    sta    (r0),y
    jsr    Add40R0
    bne    55$
    ldy    #0
    lda    #((BACKFORE<<4)|BACKBACK)
    sta    (r0),y
    cpy    #160
    bne    70$
Add40R0:
    AddVW    #40,r0
;when you need to look ahead in the command buffer for a text string or
;another command, this example will show you how to
;when you need to look ahead in the command buffer for a text string or
;another command, this example will show you how to do it.
;The 'getkey' command has to look forward through an exec or startup file
;for a left-curly brace followed by a character that represents the key
;that the user has pressed. This example does it in a similar manner.
;a4 always points to the next command or your parameter if there is one.
;From that point until the end of the buffer is all text until a null-byte
;is encountered, signifying the end of the command buffer, or the
;startup buffer. It makes no difference whether your command is coming
;from a startup file in the startup buffer or the keyboard in the
;command buffer. The only difference is that the startup buffer can hold
;more commands.
;In this example, we are simply looking for a string
;called 'skip'. If goodflag is set upon return then r0 is pointing at
;skip. No ifs, ands, or buts.
;a4 does not get altered, however we can skip ahead if we'd like
;by copying r0 to a4. This particular code loops around perhaps a little
;too much, but it works perfectly and will return with r0 either pointing
;at skip for sure or definitely not pointing at it.
FindSkip:
    MoveW    a4,r0    ;point r0 at the start of what's left
            ;in the buffer.
    LoadW    r1,#skipText    ;point r1 at the text to compare to.
    bra    15$    ;go check the first byte.
            ;(the first byte doesn't have to be
            ;a space)
    ldy    #0    ;let's look for the next terminator.
            ;because there has to be a space before
            ;and after 'skip'.
    lda    (r0),y    ;get a byte.
    beq    90$    ;branch if end of buffer.
    jsr    CkTerminators    ;is this a terminator?
    jsr    IncR0    ;increment r0 before checking goodflag.
    bit    goodflag    ;so, was it?
    bmi    15$    ;branch if so.
    bpl    10$    ;or branch if not and keep looking.
    lda    (r0),y    ;get the next byte.
    beq    90$    ;branch if end of buffer.
    cmp    skipText+0    ;does this match the 's'in 'skip'?
    bne    13$    ;branch in case it's a terminator.
    ldx    #r0    ;let GEOS kernal check
    ldy    #r1    ;the two strings.
    lda    #4    ;four characters.
    jsr    CmpFString    ;are they equal?
    beq    60$    ;branch if so.
    jsr    IncR0
    bra    10$    ;branch always.
;at this point, we have one more check to make. We make sure that the
;user is using the correct syntax by putting a space after 'skip'.
    ldy    #4    ;point at the byte past 'skip'.
    lda    (r0),y    ;and fetch that byte.
    jsr    CkTerminators    ;maybe this string here is 'skippy'
    bit    goodflag    ;or something else.
    bmi    80$
    jsr    IncR0    ;point at
    jsr    CkTerminators    ;maybe this string here is 'skippy'
    bit    goodflag    ;or something else.
    bmi    80$
    jsr    IncR0    ;point at the next byte.
    bra    10$    ;branch if not 'skip' with a space
            ;and keep looking.
    rts        ;goodflag is already set.
    jmp    nogood    ;no skip in this buffer.
skipText:
    .byte    "skip"
IncR0:
    inc    r0L    ;increment r0 to the next byte.
    bne    10$    ;branch if it didn't roll over.
    inc    r0H    ;otherwise increment the high byte.
    jsr    ClearScreen    ;clear th
The geoSHELL Programmer's Development Package    Source-PAGE