[net.micro.amiga] Graphics from Microsoft basic

patrick@nmtvax.UUCP (Patrick Madden) (06/14/86)

Help!  We need to print a graphics screen to an Epson printer (LX-80)
from a Microsoft basic program.   There must be an easy way
to do this, so I'd appreciate it if someone could enlighten me.  Please
Email (news hasn't been working too god lately).


				Thanks in Advance

Patrick Madden....!ucbvax!unmvax!nmtvax!patrick
"If man were meant to compute, he'd have been born with a brain."

carolyn@cbmvax.UUCP (06/17/86)

In article <1048@nmtvax.UUCP> patrick@nmtvax.UUCP (Patrick Madden) writes:
>Help!  We need to print a graphics screen to an Epson printer (LX-80)
>from a Microsoft basic program.   There must be an easy way
>to do this, so I'd appreciate it if someone could enlighten me. 

   I hope this all gets through.  I'll put the ScreenPrint program first.
It requires an exec.bmap in the directory you are cd'd (CHDIR'd) to.
Following ScreenPrint are NewConvertFD and exec_lib.fd in case you need to
make the exec.bmap.  I am also attaching dos_lib.fd in case you want to make
yourself a New dos.bmap capable of xRead, xWrite, etc.  Note - make
sure you don't have any extra linefeeds (blank lines) at the end of
each fd file before running NewConvertFD on it.

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Carolyn Scheppner -- CBM   >>Amiga Technical Support<<
                     UUCP  ...{allegra,caip,ihnp4,seismo}!cbmvax!carolyn 
                     PHONE 215-431-9180
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

----------------------------------------------------------------------------
REM  ScreenPrint
REM  Carolyn Scheppner   CBM  04/86
REM
REM  Graphic screen dump to the printer
REM   using exec library calls
REM  Requires exec.bmap
REM  Use Preferences to select options
REM   such as GrayScale and Negative

REM  ***  Calling Program  ***

REM  Custom Screen, some graphics
w = 320: h = 200: d = 5
SCREEN 2,w,h,d,1
t$=" D = Draw   P = Print   Q = Quit "
WINDOW 2,t$,,15,2
PALETTE 0,1,1,1
PALETTE 1,.2,.4,.8

GOSUB DrawLines:

MainLoop:
k$ = INKEY$
IF k$ = "d" THEN 
   GOSUB DrawLines:
ELSEIF k$ = "p" THEN
   BorderFlag% = 0  'No borders printed
   GOSUB ScreenDump
   REM  Time to read any error msgs
   FOR de = 1 TO 5000: NEXT
ELSEIF k$ = "q" THEN 
   GOTO Quit:
END IF
GOTO MainLoop:

Quit:
WINDOW CLOSE 2
SCREEN CLOSE 2
END


DrawLines:
CLS               
RANDOMIZE  TIMER
FOR k = 1 TO 12
   x1 = 80 + INT(RND(1) * (w - 160)) 
   x2 = 80 + INT(RND(1) * (w - 160))
   y1 = 40 + INT(RND(1) * (h - 100))
   y2 = 40 + INT(RND(1) * (h - 100))
   dx = 2 + INT(RND(1) * 3)
   IF RND(1) < .5 THEN dx = -dx
   dy = 2 + INT(RND(1) * 2)
   IF RND(1) < .5 THEN dy = -dy
   co = 1 + INT(RND(1) * 16)
   nl = 12 + INT(RND(1) * 10) 
   FOR j = 1 TO nl
      LINE (x1,y1)-(x2,y2),co
      x1 = x1 + dx
      x2 = x2 + dx
      y1 = y1 + dy
      y2 = y2 - dy
   NEXT
NEXT
RETURN


END


ScreenDump:

REM  If first call of this routine 

REM   declare the exec library functions
REM    which return values

IF AlreadyDeclared = 0 THEN
 DECLARE FUNCTION AllocSignal%() LIBRARY
 DECLARE FUNCTION AllocMem&()    LIBRARY
 DECLARE FUNCTION FindTask&()    LIBRARY
 DECLARE FUNCTION DoIO&()        LIBRARY
 DECLARE FUNCTION OpenDevice&    LIBRARY
 AlreadyDeclared = 1
END IF

REM  Get addresses of the structures

sWindow&   = WINDOW(7)
sScreen&   = PEEKL(sWindow& + 46)
sViewPort& = sScreen& + 44
sRastPort& = sScreen& + 84
sColorMap& = PEEKL(sViewPort& + 4)

REM  Get Screen width, height, modes 

maxWidth%  = PEEKW(sScreen& + 12)
maxHeight% = PEEKW(sScreen& + 14)
viewModes% = PEEKW(sViewPort& + 32)

REM Set up parameters for dump command

command%  = 11   'Printer command number
srcX% = 0        'Send whole screen
srcY% = 0 
srcWidth%  = maxWidth%
srcHeight% = maxHeight%
destRows& = 0    'Dump will compute
destCols& = 0
special% = &H84  'FullCol | Aspect

IF BorderFlag% = 0 THEN  'No Borders
   srcX% = srcX% + 3
   srcY% = srcY% + 11
   srcWidth%  = srcWidth% - 3 - 11
   srcHeight% = srcHeight% - 11 - 3
END IF   

LIBRARY "exec.library"


REM *** CreatePort ***

sigBit% =  AllocSignal%(-1)
ClearPublic& = 65537&
msgPort& = AllocMem&(40,ClearPublic&)
IF msgPort& = 0 THEN
   PRINT "Can't allocate msgPort"
   GOTO cleanup4
END IF


POKE(msgPort& + 8), 4 'Type=NT_MSGPORT
POKE(msgPort& + 9), 0 'Priority 0 
portName$ = "MyPrtPort"+CHR$(0)
POKEL(msgPort& + 10), SADD(portName$)
POKE(msgPort& + 14), 0 'Flags
POKE(msgPort& + 15), sigBit%
sigTask& = FindTask&(0)
POKEL(msgPort& + 16), sigTask&

CALL AddPort(msgPort&)  'Add the port 


REM  *** CreatExtIO ***

ioRequest& = AllocMem&(64,ClearPublic&)
IF ioRequest& = 0  THEN
   PRINT "Can't allocate ioRequest"
   GOTO cleanup3
END IF

POKE(ioRequest& + 8),5 'Type=NT_MESSAGE
POKE(ioRequest& + 9),0 'Priority 0
POKEL(ioRequest& + 14), msgPort&


REM  *** Open the Printer Device ***

devName$ = "printer.device"+CHR$(0)
pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0)
IF pError& <> 0  THEN
   PRINT "Can't open printer"
   GOTO cleanup2
END IF


REM  *** Dump the RastPort ***

POKEWW(ioRequest& + 28), command%
POKEL(ioRequest& + 32), sRastPort&
POKEL(ioRequest& + 36), sColorMap&
POKEL(ioRequest& + 40), viewModes%
POKEW(ioRequest& + 44), srcX%
POKEW(ioRequest& + 46), srcY%
POKEW(ioRequest& + 48), srcWidth%
POKEW(ioRequest& + 50), srcHeight%
POKEL(ioRequest& + 52), destCols&
POKEL(ioRequest& + 56), destRows&
POKEW(ioRequest& + 60), special%

ioError& = DoIO&(ioRequest&)
IF ioError& <> 0 THEN
   PRINT "DumpRPort error =" ioError&
   GOTO cleanup1
END IF


cleanup1:
   REM  *** Close Printer Device ***
   CALL CloseDevice(ioRequest&)

cleanup2:
   REM  *** DeleteExtIO ***
   POKE(ioRequest& + 8), &HFF
   POKEL(ioRequest& + 20), &HFFFF
   POKEL(ioRequest& + 24), &HFFFF
   CALL FreeMem(ioRequest&,64)

cleanup3:
   REM  *** DeletePort ***
   CALL RemPort(msgPort&)
   POKE(msgPort& + 8), &HFF  
   POKEL(msgPort& + 20), &HFFFF
   CALL FreeSignal(sigBit%)
   CALL FreeMem(msgPort&,40)
   
cleanup4:   
   LIBRARY CLOSE

RETURN
   
      
----------------------------------------------------------------------------
'Program: ConvertFd - created Aug 9, 1985
'This program converts .fd files, like 'graphics_lib.fd' to
' .bmap format files, like 'graphics.bmap', so BASIC
' programs can access libraries of machine language routines
' by name via the LIBRARY statement.
'
' Modified  01/86 by Carolyn Scheppner  CBM
'   Prepends an x to all function names which
'    conflict with AmigaBasic keywords.
'    See data statements at end of program for
'    known conflicts.  To call these functions,
'    prepend an x  (example  xRead).
'   Saves the .bmap file in current or specified
'    directory (previously saved in LIBS:).
'    For your program to access the .bmap via
'    LIBRARY, it must be in the current dir
'    or the LIBS: dir.
'   As far as I know, you MUST name your .bmap
'    libraryname.bmap.  The libraryname is the
'    part of the .fd file name before the _.
'    (example   dos.bmap from dos_lib.fd)


  DEFINT a-Z    'by default, all variables ares integer

  REM ******** for conflicting tokens ********
  READ cnt       'count of conflicting tokens
  DIM con$(cnt)
  FOR k = 0 TO cnt-1: READ con$(k): NEXT
  REM ****************************************

  INPUT "Enter name of .fd file to read > ",fdFilename$
  OPEN fdFilename$ FOR INPUT AS #1
  INPUT "Enter name of .bmap file to produce > ",bmapFilename$
  OPEN bmapFilename$ FOR OUTPUT AS #2
  WHILE NOT EOF(1)
    GetLine
    IF char$ = "#" THEN
      'lines which begin with "#" are command lines
      GOSUB GotCommand
    ELSEIF char$ = "*" THEN
      'lines which begin with "*" are comment lines
    ELSE
      'all other lines define a function in the library
      GOSUB GotFunction
    END IF
  WEND
  CLOSE
  END

GotCommand:
  GetChar  'skip 1st "#"
  GetChar  'skip 2nd "#"
  GetToken
  IF token$ = "bias" THEN
    GetNum
    offset = -num
  END IF
 ram: RETURN

GotFunction:
  GetToken  'token$=function's name

  REM **** prepend conflicting tokens with 'x' ****
  k$ = token$
  FOR k = 0 TO cnt-1
     IF k$ = con$(k) THEN token$ = "x" + token$ 
  NEXT   
  REM **********************************************

  funcOffset=offset
  offset=offset-6
  parms$=""
  SkipTill "(": IF char$="" THEN BadFileFormat
  SkipTill ")": IF char$="" THEN BadFileFormat
  GetChar
  IF char$<>"" THEN
    SkipTill "(": IF char$="" THEN BadFileFormat
    WHILE char$ <> ")"
      GetChar 'skip ( or , or /
      IF char$<>")" THEN
        GOSUB GetRegister
        IF register=0 THEN BadFileFormat
        IF register=-1 THEN
          PRINT "Warning: Function ";token$;" not included because it"
          PRINT " needs a parameter passed in a register BASIC cannot"
          PRINT " conform to."
          PRINT
          RETURN
        END IF
        parms$ = parms$+CHR$(register)
         'tells BASIC which register to put this parm into
      END IF
    WEND
  END IF
  AddEntry token$,funcOffset
  PRINT #2,parms$;   'tells BASIC what registers to pass parms in
  PRINT #2,CHR$(0);  'marks end of function entry
  RETURN

BadFileFormat:
  PRINT "Error: ";fdFilename$;" has a format error"
  PRINT "In line:";lineNum;":";buf$
  PRINT "In column:";column
  CLOSE
  STOP
  

'map {d0,d1,d2,d3,d4,d5,d6,d7,a0,a1,a2,a3,a4} to {1,..,13}
GetRegister:
  uchar$=UCASE$(char$)
  IF uchar$="D" THEN
    register=1
  ELSEIF uchar$="A" THEN
    register = 9
  ELSE
    register=0  'error
    RETURN
  END IF
  GetChar  'skip a or d
  i=ASC(char$)-48
  IF i<0 OR i>7 THEN register=0: RETURN  'error
  GetChar  'skip digit
  register=register+i
  IF register>13 THEN register=-1  'error
  RETURN

SUB AddEntry(nam$, liboffset%) STATIC
  highByte = PEEK(VARPTR(liboffset%))
  lowByte = PEEK(VARPTR(liboffset%)+1)
  PRINT #2,nam$; CHR$(0); CHR$(highByte); CHR$(lowByte);
  END SUB

SUB GetLine STATIC
  SHARED buf$,column,lineNum
  LINE INPUT #1,buf$
  column = 0
  GetChar
  lineNum = lineNum+1
  END SUB

SUB GetNum STATIC
  SHARED num,token$
  GetToken
  num = VAL(token$)
  END SUB

SUB GetToken STATIC
  SHARED buf$,char$,token$
  SkipWhiteSpace
  token$=""
  uchar$=UCASE$(char$)
  WHILE ((uchar$>="A") AND (uchar$<="Z")) OR ((uchar$>="0") AND (uchar$<="9")) OR (uchar$="-")
    token$=token$+char$
    GetChar
    uchar$ = UCASE$(char$)
  WEND
  END SUB

SUB SkipTill(stopChar$) STATIC
  SHARED char$
  WHILE (char$ <> stopChar$) AND (char$ <> "")
    GetChar
  WEND
  END SUB

SUB SkipWhiteSpace STATIC
  SHARED char$
  WHILE (char$=" ") OR (char$=CHR$(9))
    GetChar
  WEND
  END SUB

SUB GetChar STATIC
  SHARED column,char$,buf$
  column = column + 1
  char$ = MID$(buf$,column,1)
  END SUB
       
REM **** conficting token count and tokens ****                
DATA 11                
DATA abs, Close, Exit, Input, Open, Output
DATA Read, tan, Translate, Wait, Write
----------------------------------------------------------------------------
##base _SysBase
##bias 30
##private
*------ special functions ---------------------------------------------
Supervisor()
ExitIntr()
Schedule()
Reschedule()
Switch()
Dispatch()
Exception()
##public
InitCode(startClass,version)(D0/D1)
InitStruct(initTable,memory,size)(A1/A2,D0)
MakeLibrary(funcInit,structInit,libInit,dataSize,codeSize)(A0/A1/A2,D0/D1)
MakeFunctions(target,functionArray,funcDispBase)(A0,A1,A2)
FindResident(name)(A1)
InitResident(resident,segList)(A1,D1)
Alert(alertNum,parameters)(D7,A5)
Debug()
*------ interrupts ----------------------------------------------------
Disable()
Enable()
Forbid()
Permit()
SetSR(newSR,mask)(D0/D1)
SuperState()
UserState(sysStack)(D0)
SetIntVector(intNumber,interrupt)(D0/A1)
AddIntServer(intNumber,interrupt)(D0/A1)
RemIntServer(intNumber,interrupt)(D0/A1)
Cause(interrupt)(A1)
*------ memory allocation: ---------------------------------------------
Allocate(freeList,byteSize)(A0,D0)
Deallocate(freeList,memoryBlock,byteSize)(A0/A1,D0)
AllocMem(byteSize,requirements)(D0/D1)
AllocAbs(byteSize,location)(D0/A1)
FreeMem(memoryBlock,byteSize)(A1,D0)
AvailMem(requirements)(D1)
AllocEntry(entry)(A0)
FreeEntry(entry)(A0)
*------ lists: ---------------------------------------------------------
Insert(list,node,pred)(A0/A1/A2)
AddHead(list,node)(A0/A1)
AddTail(list,node)(A0/A1)
Remove(node)(A1)
RemHead(list)(A0)
RemTail(list)(A0)
Enqueue(list,node)(A0/A1)
FindName(list,name)(A0/A1)
*------ tasks: ---------------------------------------------------------
AddTask(task,initPC,finalPC)(A1/A2/A3)
RemTask(task)(A1)
FindTask(name)(A1)
SetTaskPri(task,priority)(A1,D0)
SetSignal(newSignals,signalSet)(D0/D1)
SetExcept(newSignals,signalSet)(D0/D1)
Wait(signalSet)(D0)
Signal(task,signalSet)(A1,D0)
AllocSignal(signalNum)(D0)
FreeSignal(signalNum)(D0)
AllocTrap(trapNum)(D0)
FreeTrap(trapNum)(D0)
*------ messages: ------------------------------------------------------
AddPort(port)(A1)
RemPort(port)(A1)
PutMsg(port,message)(A0/A1)
GetMsg(port)(A0)
ReplyMsg(message)(A1)
WaitPort(port)(A0)
FindPort(name)(A1)
*------ libraries: -----------------------------------------------------
AddLibrary(library)(A1)
RemLibrary(library)(A1)
OldOpenLibrary(libName)(A1)
CloseLibrary(library)(A1)
SetFunction(library,funcOffset,funcEntry)(A1,A0,D0)
SumLibrary(library)(A1)
*------ devices: -------------------------------------------------------
AddDevice(device)(A1)
RemDevice(device)(A1)
OpenDevice(devName,unit,ioRequest,flags)(A0,D0/A1,D1)
CloseDevice(ioRequest)(A1)
DoIO(ioRequest)(A1)
SendIO(ioRequest)(A1)
CheckIO(ioRequest)(A1)
WaitIO(ioRequest)(A1)
AbortIO(ioRequest)(A1)
*------ resources: ----------------------------------------------------
AddResource(resource)(A1)
RemResource(resource)(A1)
OpenResource(resName,version)(A1,D0)
*------ new functions:
##private
RawIOInit()
RawMayGetChar()
RawPutChar(char)(d0)
RawDoFmt()(A0/A1/A2/A3)
##public
GetCC()
TypeOfMem(address)(A1);
Procure(semaport,bidMsg)(A0/A1)
Vacate(semaport)(A0)
OpenLibrary(libName,version)(A1,D0)
##end
----------------------------------------------------------------------------
##base _DOSBase
##bias 30
##public
Open(name,accessMode)(D1/D2)
Close(file)(D1)
Read(file,buffer,length)(D1/D2/D3)
Write(file,buffer,length)(D1/D2/D3)
Input()
Output()
Seek(file,position,offset)(D1/D2/D3)
DeleteFile(name)(D1)
Rename(oldName,newName)(D1/D2)
Lock(name,type)(D1/D2)
UnLock(lock)(D1)
DupLock(lock)(D1)
Examine(lock,fileInfoBlock)(D1/D2)
ExNext(lock,fileInfoBlock)(D1/D2)
Info(lock,parameterBlock)(D1/D2)
CreateDir(name)(D1)
CurrentDir(lock)(D1)
IoErr()
CreateProc(name,pri,segList,stackSize)(D1/D2/D3/D4)
Exit(returnCode)(D1)
LoadSeg(fileName)(D1)
UnLoadSeg(segment)(D1)
##private
GetPacket(wait)(D1)
QueuePacket(packet)(D1)
##public
DeviceProc(name)(D1)
SetComment(name,comment)(D1/D2)
SetProtection(name,mask)(D1/D2)
DateStamp(date)(D1)
Delay(timeout)(D1)
WaitForChar(file,timeout)(D1/D2)
ParentDir(lock)(D1)
IsInteractive(file)(D1)
Execute(string,file,file)(D1/D2/D3)
##end

-- 
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Carolyn Scheppner -- CBM   >>Amiga Technical Support<<
                     UUCP  ...{allegra,caip,ihnp4,seismo}!cbmvax!carolyn 
                     PHONE 215-431-9180
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=