Fresh IDE . Artifact [0a728078a6]
Not logged in

This repository is a mirror!

The original is located on: https://fresh.flatassembler.net/fossil/repo/fresh
If you want to follow the project, please update your remote-url

Artifact 0a728078a6483a731dec3f7629e300641eced07d:


; checks for procedure call on current line of text and then shows a hint window with
; procedure definition line (if available)

cCallStdCall text 'stdcall'
cCallCCall   text 'ccall'
cCallInvoke  text 'invoke'
cCallCInvoke text 'cinvoke'
cProcName    text 'proc '

cPAFontName  text 'Trebuchet MS'


uglobal
  hPAHint dd ?
  hPAFontNormal dd ?
  hPAFontBold   dd ?
endg

initialize InitPAHint
begin
        invoke  CreateFontA, -11, 0, 0, 0, FW_NORMAL,                 \
                            0, 0, 0, 0,                              \
                            OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,           \
                            FF_DONTCARE, cPAFontName
        mov     [hPAFontNormal], eax

        invoke  CreateFontA, -11, 0, 0, 0, FW_BOLD,                                                \
                            0, 0, 0, 0,                         \
                            OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,           \
                            FF_DONTCARE, cPAFontName
        mov     [hPAFontBold], eax
        return
endp


finalize FreePAHint
begin
        invoke  DeleteObject, [hPAFontNormal]
        invoke  DeleteObject, [hPAFontBold]
        return
endp




proc CreatePAHint, .parent
begin
        cmp     [hPAHint], 0
        jne     .exit

        invoke  CreateWindowExA, 0, cStaticClassName, 0,                   \
                WS_POPUP or WS_BORDER or SS_OWNERDRAW or SS_LEFT,         \
                10, 10, 350, 300, [.parent], 0, [hInstance], 0
        mov     [hPAHint], eax
        stdcall SubclassWindow, eax, procPAHint

.exit:
        invoke  SetWindowLongA, [hPAHint], GWL_HWNDPARENT, [.parent]
        call    UpdatePAHint
        return
endp



; Returns pointer to the string with current line from the editor.
; If the current line is continuation of some of the previous lines, they are included as well to the line.
;
; returns:
; eax pointer to the line buffer.
; ecx contains offset in the string of the cursor.
proc GetCurrentLine, .asmedit
.aepos AEPOS

.ptrbuffer   dd ?
.buffersize  dd ?
.bufferlimit dd ?

.caret  dd ?

begin
        push    ebx esi edi

        mov     [.buffersize], $400
        mov     [.bufferlimit], $400- $104
        stdcall GetMem, [.buffersize]
        mov     edi, eax
        mov     [.ptrbuffer], eax

        lea     eax, [.aepos]
        invoke  SendMessageA, [.asmedit], AEM_GETPOS, eax, 0

        mov     ebx, [.aepos.caretLine]

.begloop:
        dec     ebx
        jz      .lineloop
        call    .IsLineMerged
        jc      .begloop

.lineloop:
        inc     ebx
        cmp     ebx, [.aepos.caretLine]
        ja      .endprocessing
        jne     .caretok

        mov     eax, edi
        sub     eax, [.ptrbuffer]
        mov     [.caret], eax

.caretok:
        mov     eax, edi
        sub     eax, [.ptrbuffer]
        cmp     eax, [.bufferlimit]
        jb      .bufferok

        sub     edi, [.ptrbuffer]
        shl     [.buffersize], 1


        stdcall ResizeMem, [.ptrbuffer], [.buffersize]
        mov     [.ptrbuffer], eax
        add     edi, eax

        push    [.buffersize]
        pop     [.bufferlimit]
        sub     [.bufferlimit], $104

.bufferok:
        invoke  SendMessageA, [.asmedit], AEM_GETLINEDATA, ebx, edi

        xor     ecx, ecx
        dec     ecx
        xor     esi, esi
.endloop:
        inc     ecx
        cmp     ecx, $100
        je      .endline1

        cmp     byte [edi+ecx], ';'
        je      .endline
        cmp     byte [edi+ecx], '\'
        je      .endline
        cmp     byte [edi+ecx], ' '
        je      .endloop
        lea     esi, [ecx+1]
        jmp     .endloop

.endline1:
        mov     ecx, esi

.endline:
        lea     edi, [edi+ecx+1]
        mov     byte [edi-1], ' '
        jmp     .lineloop

.endprocessing:
        mov     dword [edi-1], 0

        mov     eax, [.ptrbuffer]
        mov     ecx, [.caret]
        add     ecx, [.aepos.caretPosition]
        dec     ecx

        pop     edi esi ebx
        return

.IsLineMerged:
        invoke  SendMessageA, [.asmedit], AEM_GETLINEPTR, ebx, 0
        xor     ecx, ecx

.mergloop:
        cmp     byte [eax+ecx+8], ';'
        je      .notmerged

        cmp     byte [eax+ecx+8], '\'
        je      .merged

        inc     ecx
        cmp     ecx, $100
        jne     .mergloop

.notmerged:
        clc
        retn

.merged:
        stc
        retn
endp




proc UpdatePAHint
  .aepos  AEPOS
  .caret  AECARETXY
  .ptrBuffer dd ?
  .arg    dd ?
  .save   dd ?
  .edit   dd ?
  .begarg dd ?
begin
        cmp     [hPAHint], 0
        je      .exit


        invoke  GetWindowLongA, [hPAHint], GWL_HWNDPARENT
        mov     [.edit], eax

        stdcall StrDup, cProcName
        mov     [.arg], eax

        lea     eax, [.aepos]
        invoke  SendMessageA, [.edit], AEM_GETPOS, eax, 0

        stdcall GetCurrentLine, [.edit]
        mov     [.ptrBuffer], eax
        mov     esi, eax
        mov     [.aepos.caretPosition], ecx

        mov     ebx, 5
        stdcall StrPos, esi, cCallCCall
        test    eax, eax
        jnz     .found

        inc     ebx
        stdcall StrPos, esi, cCallInvoke
        test    eax, eax
        jnz     .found

        inc     ebx
        stdcall StrPos, esi, cCallCInvoke
        test    eax, eax
        jnz     .found

        stdcall StrPos, esi, cCallStdCall
        test    eax, eax
        jz      .notfound

; search the name of the procedure
.found:
        lea     esi, [eax+ebx]

.loop:
        inc     esi
        cmp     byte [esi], 0
        je      .notfound

        cmp     byte [esi], ' '
        je      .loop

        mov     ebx, esi        ; begin of the name.

.endloop:
        inc     esi
        mov     al, [esi]
        cmp     al, 0
        je      .endfound

        cmp     al, ','
        je      .endfound

        cmp     al, ' '
        jne     .endloop

.endfound:
        mov     [.begarg], esi
        pushd   [esi]
        popd    [.save]
        mov     byte [esi], 0

        mov     edi, [ptrPreprocessed]
        test    edi, edi
        jz      .notfound

        stdcall SearchTreeExact, ebx, ptrLabels
        test    eax, eax
        jz      .notfound

        push    eax
        stdcall StrCat, [.arg], ebx

        mov     eax, [.save]
        mov     [esi], eax
        pop     esi             ; esi - pointer to TLabel with the procedure label.

        mov     esi, [esi+TLabel.Children]
        test    esi, esi
        jz      .endsearch

        mov     edi, [esi+TArray.count]
        lea     esi, [esi+TArray.array]

        cmp     edi, 0
        jle     .endsearch

.loopchild:
        cmp     [esi+TLabel.ValueLo], 4
        jl      .nextchild

        cmp     [esi+TLabel.SIBEx], $00010045
        je      @f
        cmp     [esi+TLabel.SIBEx], $00010025
        jne     .nextchild

@@:
        mov     eax, [esi+TLabel.iName]
        add     eax, [ptrNames]
        stdcall StrCharCat, [.arg], ', .'
        stdcall StrCat, [.arg], eax

.nextchild:
        add     esi, sizeof.TLabel
        dec     edi
        jnz     .loopchild

.endsearch:

; what argument is now?
        mov     esi, [.begarg]
        mov     ebx, [.aepos.caretPosition]
        add     ebx, [.ptrBuffer]
        xor     ecx, ecx
        inc     ecx

; here allows use call macros with space (like the standard FASM macros) or with comma
; (like in FreshLib and the old FASM macros) separated arguments
.skip_first:
        cmp     esi, ebx
        jae     .endcount

        lodsb
        cmp     al, ' '
        je      .skip_first
        cmp     al, ','
        jne     .commaloop

        dec     ecx     ; comma separated arguments has been used.
        dec     esi

.commaloop:
        cmp     esi, ebx
        jae     .endcount
        lodsb

        cmp     al, "'"
        je      .skip_quoted
        cmp     al, '"'
        je      .skip_quoted

        cmp     al, ','
        jne     .commaloop
        inc     ecx
        jmp     .commaloop

.skip_quoted:
        mov     ah, al
.quoteloop:
        lodsb
        cmp     al, ah
        je      .commaloop
        cmp     esi, ebx
        jb      .quoteloop

.endcount:
        invoke  SetWindowLongA, [hPAHint], GWL_USERDATA, ecx

locals
  .info   MONITORINFO
  .height dd ?
endl
; then set the possition
  ; first, compute the size of the window.
        stdcall StrPtr, [.arg]
        invoke  SendMessageA, [hPAHint], WM_SETTEXT, 0, eax

        invoke  GetDC, [hPAHint]
        push    eax
        invoke  CreateCompatibleDC, eax
        push    eax
        stdcall PaintPAHint, [hPAHint], eax
        mov     [.height], eax
        invoke  DeleteDC ; from the stack
        invoke  ReleaseDC, [hPAHint] ; from the stack

  ; then compute the place

        lea     ebx, [.caret]
        invoke  SendMessageA, [.edit], AEM_GETCARETXY, ebx, 0
        invoke  ClientToScreen, [.edit], ebx
        add     ebx, 8
        invoke  ClientToScreen, [.edit], ebx
        sub     ebx, 8

        mov     [.info.cbSize], sizeof.MONITORINFO
        lea     ecx, [.info]
        invoke  GetMonitorInfoA, eax, ecx

        mov     eax, 350
        mov     edx, [.height]

        mov     ecx, [ebx+AECARETXY.x0]
        add     eax, ecx
        sub     [.info.rcWork.right], eax
        jns     @f
        add     ecx, [.info.rcWork.right]
@@:
        mov     [.info.rcWork.right], ecx

        mov     ecx, [ebx+AECARETXY.y1]
        sub     [.info.rcWork.bottom], edx
        cmp     ecx, [.info.rcWork.bottom]
        jbe     @f
        mov     ecx, [ebx+AECARETXY.y0]
        sub     ecx, edx
@@:
        mov     [.info.rcWork.top], ecx

        invoke  SetWindowPos, [hPAHint], 0, [.info.rcWork.right], ecx, 350, [.height], SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW
        invoke  InvalidateRect, [hPAHint], 0, TRUE

.finish:
        stdcall StrDel, [.arg]
        stdcall FreeMem, [.ptrBuffer]
.exit:
        return

.notfound:
        invoke  PostMessageA, [hPAHint], WM_CLOSE, 0, 0
        jmp     .finish
endp








proc procPAHint, .hwnd, .wmsg, .wparam, .lparam
begin

        mov     ebx, [.wmsg]
        dispatch ebx

.ondefault:
        stc
        return

;___________________________________________________________________________
;
oncase WM_ERASEBKGND
cPABackground = $e0ffff
locals
  .bkrect RECT
endl
        lea     ebx, [.bkrect]
        invoke  GetClientRect, [.hwnd], ebx
        invoke  CreateSolidBrush, cPABackground
        push    eax
        invoke  FillRect, [.wparam], ebx, eax
        invoke  DeleteObject ; from the stack
        xor     eax, eax
        dec     eax
        clc
        return

;___________________________________________________________________________
;
oncase WM_PAINT
locals
  .update RECT
  .ps     PAINTSTRUCT
endl

cPAColorGray  = $000000
cPAColorLight = $ff0000

        lea     eax, [.update]
        invoke  GetUpdateRect, [.hwnd], eax, TRUE
        test    eax, eax
        jz      .finishpaint

        lea     esi, [.ps]
        invoke  BeginPaint, [.hwnd], esi
        test    eax, eax
        jz      .endpaint

        stdcall PaintPAHint, [.hwnd], [esi+PAINTSTRUCT.hdc]

.endpaint:
        invoke  EndPaint, [.hwnd], esi

.finishpaint:
        xor     eax, eax
        clc
        return


;___________________________________________________________________________
;
oncase WM_CLOSE
        invoke  DestroyWindow, [.hwnd]
        mov     [hPAHint], 0
        clc
        return


        enddispatch
endp




; paints the hint window and returns the size needed.
; eax: height of the window needed.
proc PaintPAHint, .hwnd, .hdc
.str dd ?
.deffont dd ?
.point POINT
.metrics TEXTMETRIC
begin
        push    ebx edi

        stdcall GetControlText2, [.hwnd]
        mov     [.str], eax

        stdcall StrPtr, eax
        mov     edi, eax

        stdcall StrLen, edi
        mov     ebx, eax

        invoke  GetWindowLongA, [.hwnd], GWL_USERDATA
        test    eax, eax
        je      .textready

        xor     ebx, ebx
        dec     ebx

.commaloop:
        inc     ebx
        cmp     byte [edi+ebx], 0
        je      .textready

        cmp     byte [edi+ebx], ','
        jne     .commaloop
        dec     eax
        jnz     .commaloop

.here:
        inc     ebx

.textready:
        invoke  SetTextAlign, [.hdc], TA_LEFT or TA_TOP or TA_UPDATECP
        invoke  SetTextColor, [.hdc], cPAColorGray
        invoke  SetBkMode, [.hdc], TRANSPARENT
        invoke  SelectObject, [.hdc], [hPAFontNormal]
        mov     [.deffont], eax

        lea     eax, [.metrics]
        invoke  GetTextMetricsA, [.hdc], eax

        mov     eax, 4
        sub     eax, [.metrics.tmInternalLeading]

        invoke  MoveToEx, [.hdc], 2, eax, 0
        stdcall TextOutWithWrap, [.hdc], 350, edi, ebx

        cmp     byte [edi+ebx], 0
        je      .enddraw

        lea     edi, [edi+ebx]
        xor     ebx, ebx
        dec     ebx

.comma2:
        inc     ebx
        cmp     byte [edi+ebx], 0
        je      .drawbold
        cmp     byte [edi+ebx], ','
        jne     .comma2

.drawbold:
        invoke  SelectObject, [.hdc], [hPAFontBold]
        invoke  SetTextColor, [.hdc], cPAColorLight

        stdcall TextOutWithWrap, [.hdc], 350, edi, ebx

        cmp     byte [edi+ebx], 0
        je      .enddraw

        lea     edi, [edi+ebx]
        invoke  SelectObject, [.hdc], [hPAFontNormal]
        invoke  SetTextColor, [.hdc], cPAColorGray
        stdcall StrLen, edi

        stdcall TextOutWithWrap, [.hdc], 350, edi, eax

.enddraw:
        invoke  SelectObject, [.hdc], [.deffont]
        stdcall StrDel, [.str]

        lea     eax, [.point]
        invoke  MoveToEx, [.hdc], 0, 0, eax

        mov     eax, [.metrics.tmHeight]
        add     eax, [.point.y]
        add     eax, 2
        pop     edi ebx
        return
endp




proc TextOutWithWrap, .hdc, .width, .ptrstring, .count
.size SIZE
.point POINT
begin
        push    ebx esi

        mov     esi, [.ptrstring]
.wordloop:
        xor     ebx, ebx

.loopstring:
        cmp     ebx, [.count]
        jae     .word2

        cmp     byte [esi+ebx], ' '
        je      .word
        cmp     byte [esi+ebx], ','
        je      .word

        inc     ebx
        jmp     .loopstring

.word:
        inc     ebx
.word2:
        lea     eax, [.size]
        invoke  GetTextExtentPoint32A, [.hdc], esi, ebx, eax
        lea     eax, [.point]
        invoke  MoveToEx, [.hdc], 0, 0, eax
        invoke  MoveToEx, [.hdc], [.point.x], [.point.y], 0

        mov     eax, [.size.cx]
        add     eax, [.point.x]
        cmp     eax, [.width]
        jbe     .outputit

        cmp     [.point.x], 2   ; left most point.
        je      .wrapit

; next line
        mov     eax, [.point.y]
        add     eax, [.size.cy]
        add     eax, 2
        invoke  MoveToEx, [.hdc], 2, eax, 0
        jmp     .word2

.wrapit:
        dec     ebx
        jnz     .word2
; can't be fitted - then exit

.finish:
        mov     eax, [.size.cy]
        pop     esi ebx
        return

.outputit:
        invoke  TextOutA, [.hdc], 0, 0, esi, ebx

        sub     [.count], ebx
        jle     .finish

        lea     esi, [esi+ebx]
        jmp     .wordloop
endp