* Demo05.a      Version 1.00   July 20, 2000   by Ken Shillito


*
*  This program demonstrates how ucode.library can grab Amiga fonts
*  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*  It...  (1) opens a window
*         (2) puts a Unicode glyph (grabbed from a font) on the window
*         (3) waits for the user to click the close window gadget
*         (4) shuts down
*
*  (Caution: If the program fails, it does not report why, but just exits)


 IFND what
 INCLUDE 'exec/types.i'
 INCLUDE 'UCODE:Includes/ucode.i'
 INCLUDE 'UCODE:Includes/ucodeasms.i'
 ENDC

 INCLUDE 'dos/dosextens.i'
 INCLUDE 'intuition/intuition.i'


 XREF _AbsExecBase
 XREF _LVOCloseLibrary
 XREF _LVOCloseWindow
 XREF _LVOFindTask
 XREF _LVOForbid
 XREF _LVOGetMsg
 XREF _LVOOpenDiskFont
 XREF _LVOOpenLibrary
 XREF _LVOOpenWindowTagList
 XREF _LVOReplyMsg
 XREF _LVOWaitPort


***************************************************************************
*
*                 First, do setting up
*                 ~~~~~~~~~~~~~~~~~~~~
***************************************************************************


***********  Setting up Step 1: Process Startup  **************

Start:                     ;cold startup...
 clr.l bench               ;(bench will 0 if started from CLI)
 move.l _AbsExecBase,a6
 sub.l a1,a1               ;for current task..
 jsr _LVOFindTask(a6)      ;.. find own Process structure
 move.l d0,a2              ;(A2) = our own Process structure
 tst.l pr_CLI(a2)          ;pr_CLI<>0 if from CLI
 bne.s Both                ;go if from CLI

 lea pr_MsgPort(a2),a0     ;wait for workbench startup message to arrive
 jsr _LVOWaitPort(a6)
 lea pr_MsgPort(a2),a0     ;get workbench startup message now it's here
 jsr _LVOGetMsg(a6)
 move.l d0,bench           ;remember the message, for replying &c (bench<>0)


*******   Setting up Step 2: open ucode.library *************

Both:

 IFND what
 lea uname,a1
 moveq #xxp_uver,d0
 jsr _LVOOpenLibrary(a6)
 move.l d0,ubase
 beq Quit0
 ENDC

 IFD what
 IFEQ what-3
 lea uname,a1
 moveq #xxp_uver,d0
 jsr _LVOOpenLibrary(a6)
 move.l d0,ubase
 beq Quit0
 ENDC
 IFEQ what-4
 move.l #Endcode+24,ubase  ;only assemble this if debugging
 ENDC
 ENDC


******** Setting up Step 3: make ucode_path structure   *********

 move.l ubase,a6           ;a6 = base of ucode.library
 moveq #0,d0               ;d0 = 0 = same bitplanes as default public screen
 moveq #0,d1               ;d1,d2 = 0 = no ucode_tilp structure
 moveq #0,d2
 moveq #0,d3               ;d3 = 0 = no ucode_list structure
 jsr _LVOTLUstart(a6)      ;create ucode_path
 cmp.l #10,d0
 bcs Quit1                 ;bad if can't (i.e. return code 0-4)
 move.l d0,upath           ;address of ucode_path to upath


*************  Setting up Step 4: open window ***************

 move.l upath,a0           ;get intuition.library base from ucode_path
 move.l xxp_intp(a0),a6

 sub.w #128,a7             ;room for 15 tags
 move.l a7,a0
 move.l #WA_Left,(a0)+      ;xpos = 20
 move.l #20,(a0)+
 move.l #WA_Top,(a0)+       ;ypos = 20
 move.l #20,(a0)+
 move.l #WA_Width,(a0)+     ;init width = 400
 move.l #600,(a0)+
 move.l #WA_Height,(a0)+    ;init height = 150
 move.l #75,(a0)+
 move.l #WA_MinWidth,(a0)+  ;min width = 80
 move.l #80,(a0)+
 move.l #WA_MinHeight,(a0)+ ;min height = 20
 move.l #20,(a0)+
 move.l #WA_MaxWidth,(a0)+  ;max width = unlimited
 move.l #0,(a0)+
 move.l #WA_MaxHeight,(a0)+ ;max height = unlimited
 move.l #0,(a0)+
 move.l #WA_CloseGadget,(a0)+ ;+ close gadget
 move.l #-1,(a0)+
 move.l #WA_SizeGadget,(a0)+  ;+ size gadget
 move.l #-1,(a0)+
 move.l #WA_DragBar,(a0)+   ;+ drag bar
 move.l #-1,(a0)+
 move.l #WA_Activate,(a0)+ ;open active
 move.l #-1,(a0)+
 move.l #WA_NoCareRefresh,(a0)+  ;no refresh
 move.l #-1,(a0)+
 move.l #WA_IDCMP,(a0)+
 move.l #IDCMP_CLOSEWINDOW,(a0)+ ;+ close window
 move.l #WA_Title,(a0)+
 move.l #wnam,(a0)+        ;title = *wnam
 clr.l (a0)                ;delimit tags
 sub.l a0,a0               ;a0 = 0 = no NewWindow structure
 move.l a7,a1              ;a1 = tags
 jsr _LVOOpenWindowTagList(a6)   ;open the window
 add.w #128,a7             ;discard tags
 move.l d0,wndw            ;wndw = address of window
 beq Quit2                 ;quit if can't open window


***************** Setting up Step 5: Open a Font **********************

; This programs will only work if you have ruby.font in your FONTS:
; directory.

 clr.l ffont               ;clear ffont - will hold font address if loads ok

 move.l _AbsExecBase,a6    ;open diskfont.library..
 lea flibn,a1
 moveq #0,d0
 jsr _LVOOpenLibrary(a6)
 tst.l d0
 beq Quit2                 ;bad if can't

 move.l d0,a6              ;open an Amiga font (i.e. Ruby/15)
 lea tattr,a0
 jsr _LVOOpenDiskFont(a6)
 move.l d0,ffont           ;ffont is address of ruby font

 move.l a6,a1              ;close diskfont.library
 move.l _AbsExecBase,a6
 jsr _LVOCloseLibrary(a6)


***************************************************************************
*
*            Setting up is complete - now do something
*            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
***************************************************************************


******************  Step 1: set ucode_path attributes  ********************

; In order to use Amiga fonts, we must have a list of fonts with the
; unicodes they are to be glyphs for, usually in the stack.
;
; The font glyphs are grabbed into the ucode_path's internal ucode_block
; sructure, the structure which (in Demo03) stored glyphs in memkory. So,
; after TLUset grabs the required font glyphs, the font can be closed. The
; font glyphs will only be used whenever the ucode_path is TLUset to the
; same attributes (and warper parameters if any) that were being TLUset
; when the font glyphs were grabbed.
;
; You can poke any font glyph into any Unicode slot which has a glyph. e.g.
; if you have a Greek Amiga font, you ocan poke it over the Greek slphabet
; at U0370+. (Note: in more advanced ucode.library usage, ucode.library can
; compose all characters developed from a given glyph. So, for example,
; if you grab a font glyph to A (U0041), then all letters developed from A
; can use that glyph, with diactirical marks added.
;
; If you have a fontlist, you must set the xxp_fmake flag in D4, and also
; point A3 to your fontlist. The fontlist below only uses one font, but you
; can use several (e.g. one for Latin, another for Cyrillic) at once if
; you wish.


 move.l ubase,a6           ;a6 = base of ucode.library
 moveq #11,d0              ;d0 = nominal height = 11
 moveq #4,d1               ;d1 = width = 4 = NM = normal
 move.w #'SS',d2           ;d2 = style = SS = sans serif
 moveq #1,d3               ;d3 = weight = 1

 moveq #xxp_fmake,d4       ;d4 = xxp_fmake = fontlist in (A2)

 sub.w #20,a7              ;make fontset data
 tst.l ffont
 beq.s .nfont              ;(null if font didn't open for some reason)
 move.l a7,a3
 move.l ffont,(a3)+        ;first font is ffont
 move.b #$21,(a3)+
 move.b #$7E,(a3)+         ;first ASCII pair is 21-7E
 move.w #$0021,(a3)+       ;overlay Unicodes in table from 0021
 clr.w (a3)+               ;delimit ASCII pairs
.nfont:
 clr.l (a3)+               ;delimit list of fonts
 move.l a7,a3              ;a2 points to fontlist data

 move.l upath,a0           ;a0 = ucode_path
 jsr _LVOTLUset(a6)        ;set the ucode_path attributes

 add.w #20,a7              ;discard the ucode_blok and fontlist data

 move.l ffont,d0           ;close the font, if it was ever opened
 beq.s .noped
 move.l xxp_gfxp(a0),a6
 move.l d0,a1
 jsr _LVOCloseFont(a6)
.noped:


*************   Step 2: show a string in the font glyhps   ****************

; make room in stack for wint, wbox

 sub.w #16,a7              ;a7 = wint, a7+8 = wbox

; make wint

 move.l wndw,a0
 moveq #0,d0
 move.b wd_BorderLeft(a0),d0
 move.w d0,(a7)
 add.b wd_BorderRight(a0),d0
 move.w wd_Width(a0),d1
 sub.w d0,d1
 move.w d1,4(a7)
 move.b wd_BorderTop(a0),d0
 move.w d0,2(a7)
 add.b wd_BorderBottom(a0),d0
 move.w wd_Height(a0),d1
 sub.w d0,d1
 move.w d1,6(a7)

; make wbox at stack + 8 = (2, 1, wint wdth - 4, wint height -2)

 move.w #2,8+0(a7)
 move.w #1,8+2(a7)
 move.w 4(a7),d0
 subq.w #2,d0
 move.w d0,8+4(a7)
 move.w 6(a7),d0
 subq.w #2,d0
 move.w d0,8+6(a7)

; call TLUstring

 moveq #0,d0               ;d0 = xpos  } relative to wbox
 moveq #0,d1               ;d1 = ypos  }
 move.l a7,d2              ;d2 = wbox
 addq.l #8,d2
 move.l a7,d3              ;d3 = wint
 moveq #0,d4               ;d4 = flags
 bset #31,d4               ;     bit 31 = ASCII format
 bset #30,d4               ;     bit 30 = allow HTML-style '&...;' things
 moveq #1,d5               ;d5 = fgpen
 moveq #0,d6               ;d6 = bgpen
 moveq #2,d7               ;d7 = character spacing
 move.l wd_RPort(a0),a1    ;a1 = wndw's rastport
 move.l upath,a0           ;a0 = ucode_path
 lea string,a2             ;a2 = string to be printed
 move.l ubase,a6           ;a6 = base of ucode.library
 jsr _LVOTLUstring(a6)

 add.w #16,a7              ;discard wint, wbox


*********  Step 3: Wait until user clicks the CloseWindow gadget **********

Step3:
 move.l _AbsExecBase,a6
 move.l wndw,a2
 move.l wd_UserPort(a2),a0 ;(i.e. get IDCMP_CloseWindow & reply to it)
 jsr _LVOWaitPort(a6)
 move.l wd_UserPort(a2),a0
 jsr _LVOGetMsg(a6)
 tst.l d0
 beq.s Quit3
 move.l d0,a1
 jsr _LVOReplyMsg(a6)


***************************************************************************
*
*                  Finally, close everything down
*                  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
***************************************************************************


*****   Close window  *****

Quit3:
 move.l upath,a0
 move.l xxp_intp(a0),a6
 move.l wndw,a0
 jsr _LVOCloseWindow(a6)


*****   Release ucode.library structures  *****

Quit2:
 move.l ubase,a6           ;call TLUfinish
 move.l upath,a0
 jsr _LVOTLUfinish(a6)


*****   Close ucode.library  *******

Quit1:                     ;close ucode.library (unless debugging)

 IFND what
 move.l _AbsExecBase,a6
 move.l ubase,a1
 jsr _LVOCloseLibrary(a6)
 ENDC

 IFD what
 IFEQ what-3
 move.l _AbsExecBase,a6
 move.l ubase,a1
 jsr _LVOCloseLibrary(a6)
 ENDC
 ENDC


******  Exit from Program  *******

Quit0:                     ;reply to workbench startup message if any
 move.l _AbsExecBase,a6
 move.l bench,d2
 beq.s Quit
 jsr _LVOForbid(a6)
 move.l d2,a1
 jsr _LVOReplyMsg(a6)
Quit:
 rts


***************************************************************************
*
*                           Data Section
*                           ~~~~~~~~~~~~
***************************************************************************


* system data
bench: ds.l 1             ;bench = 0 if CLI, else = workbench message
ubase: ds.l 1             ;ucode.library base
uname: dc.b 'UCODE:ucode.library',0
 ds.w 0


* window data
wnam: dc.b 'Ucode Demo05',0
 ds.w 0
wndw: ds.l 1                ;window structure


* ucode.library structure
upath: ds.l 1                ;ucode_path


* font data
flibn: dc.b 'diskfont.library',0
 ds.w 0

fname: dc.b 'ruby.font',0
 ds.w 0

tattr:                       ;TextAttr for ruby/15
 dc.l fname
 dc.w 15
 dc.w 0

ffont: ds.l 1                ;will hold address of font when opened, else 0


* string to be printed
string: dc.b 'Well - my glyphs come from Ruby/15...',0
 ds.w 0